原代码如下:'////////////////////////////////////////// '中文名称: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 TypePrivate 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
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
'中文名称: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 TypePrivate 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
不过每搜索到
我的是这里的
http://game.99net.net/study/program/vb/1049956940.html