GB與BIG5內碼轉換COM原代碼

來源:互聯網
上載者:User
轉換 這個COM用到了一個VC的資源檔。就是字典。
大家可以去61.134.75.70/download/gb2big5.zip下載

原代碼如下:

'//////////////////////////////////////////
'中文名稱:GB與BIG5內碼互換控制項
'英文名稱:GB2BIG5
'作者:Blood
'版本:1.0
'製作時間:2002.3.5
'著作權 Blood 2002 - 2003
'//////////////////////////////////////////

Option Explicit

'定義變數
Dim BIG5Data As Variant
Dim GBData As Variant

'定義自訂類型,用來處理編碼的高低字問題
Type ChineseTypeA
loChar As Byte
hiChar As Byte
End Type

Private BIG5Type(&HA1 To &HFF, &H40 To &HFE) As ChineseTypeA '對應於BIG5字型檔
Private GBType(&HA7 To &HFF, &HA1 To &HFE) As ChineseTypeA '對應與GB字型檔

'//////////////////
'公用函數開始
'//////////////////

'BIG5轉換到GB的函數

Function BIG5TOGB(strSource As String) As String
Dim I As Long, Y As Long
'定義數組,用來存放BIG5和GB內碼資料
Dim bteBIG5() As Byte
Dim bteGB() As Byte

'如果輸入的內容為空白,則退出函數
If strSource = "" Then
BIG5TOGB = ""
Exit Function
End If

'將BIG5數組的類型從Unicode編碼轉換為系統預設碼
bteBIG5 = StrConv(strSource, vbFromUnicode)
'確定BIG5數組的下標,用來迴圈將所有的BIG5內容轉換為GB內碼
Y = UBound(bteBIG5)
ReDim bteGB(0 To Y)
For I = 0 To Y
If I = Y Then
bteGB(I) = bteBIG5(I)
Exit For
End If
If bteBIG5(I) < &HA1 Or bteBIG5(I + 1) < &H40 Then
bteGB(I) = bteBIG5(I)
Else
bteGB(I) = BIG5Type(bteBIG5(I), bteBIG5(I + 1)).loChar
bteGB(I + 1) = BIG5Type(bteBIG5(I), bteBIG5(I + 1)).hiChar
I = I + 1
End If
Next I
'將系統預設碼轉換為Unicode編碼
BIG5TOGB = StrConv(bteGB, vbUnicode)
'重新初始化GB數組,以釋放記憶體
Erase bteGB
End Function

'GB轉換到BIG5的函數

Function GBTOBIG5(strSource As String) As String
Dim I As Long, Y As Long
'定義數組,用來存放BIG5和GB內碼資料
Dim bteGB() As Byte
Dim bteBIG5() As Byte

'如果輸入的內容為空白,則退出函數
If strSource = "" Then
GBTOBIG5 = ""
Exit Function
End If

'將GB數組的類型從Unicode編碼轉換為系統預設碼
bteGB = StrConv(strSource, vbFromUnicode)
'確定GB數組的下標,用來迴圈將所有的BIG5內容轉換為GB內碼
Y = UBound(bteGB)
ReDim bteBIG5(0 To Y)

For I = 0 To Y
If I = Y Then
bteBIG5(I) = bteGB(I)
Exit For
End If
If bteGB(I) < &HA1 Or bteGB(I + 1) < &HA1 Then
bteBIG5(I) = bteGB(I)
Else
If bteGB(I) < &HB0 And bteGB(I + 1) >= &HA1 Then
bteBIG5(I) = GBType(bteGB(I) + 6, bteGB(I + 1)).loChar
bteBIG5(I + 1) = GBType(bteGB(I) + 6, bteGB(I + 1)).hiChar
Else
bteBIG5(I) = GBType(bteGB(I), bteGB(I + 1)).loChar
bteBIG5(I + 1) = GBType(bteGB(I), bteGB(I + 1)).hiChar
End If
I = I + 1
End If
Next I
'將系統預設碼轉換為Unicode編碼
GBTOBIG5 = StrConv(bteBIG5, vbUnicode)
'重新初始化BIG5數組,以釋放記憶體
Erase bteBIG5
End Function

'//////////////////
'公用函數結束
'//////////////////

'類初始化
Private Sub Class_Initialize()
Dim I As Long
Dim J As Long
Dim iLen As Long

'從資源檔中讀取GB與BIG5的字型檔
GBData = LoadResData(102, "CUSTOM") '//讀取GB字型檔
BIG5Data = LoadResData(101, "CUSTOM") '//讀取BIG5字型檔

For I = &HA1 To &HFE
For J = &H40 To &HFE
BIG5Type(I, J).loChar = BIG5Data(iLen)
BIG5Type(I, J).hiChar = BIG5Data(iLen + 1)
iLen = iLen + 2
Next J
Next I

iLen = 0

For I = &HA7 To &HFE
For J = &HA1 To &HFE
GBType(I, J).loChar = GBData(iLen)
GBType(I, J).hiChar = GBData(iLen + 1)
iLen = iLen + 2
Next J
Next I
End Sub



相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。