VB汉字简繁体转换

2018/1/2 11:12:41      点击:
'简繁体转换(smBig2GB)
'
Option Explicit
Dim BigData As Variant
Dim GbData As Variant
'
'将BIG码转为GB码
'函数:BigToGB
'参数:BigStr BIG码字符串
'返回值:GB码字符串
Function BigToGB(BigStr As String) As String
    Dim I As Long, Y As Long
    Dim BigByte() As Byte
    Dim GbByte() As Byte
    
    If BigStr = "" Then
        BigToGB = ""
        Exit Function
    End If
    
    BigByte = StrConv(BigStr, vbFromUnicode)
    Y = UBound(BigByte)
    ReDim GbByte(0 To Y)
    For I = 0 To Y
        If I = Y Then
            GbByte(I) = BigByte(I)
            Exit For
        End If
        If BigByte(I) < &HA1 Or BigByte(I + 1) < &H40 Then
            GbByte(I) = BigByte(I)
        Else
            GbByte(I) = PBigType(BigByte(I), BigByte(I + 1)).loChar
            GbByte(I + 1) = PBigType(BigByte(I), BigByte(I + 1)).hiChar
            I = I + 1
        End If
    Next I
    BigToGB = StrConv(GbByte, vbUnicode)
    Erase GbByte
End Function
'
'将GB码转为BIG码
'函数:GBToBig
'参数:GBStr GB码字符串
'返回值:BIG码字符串
Function GBToBig(GBStr As String) As String
    Dim I As Long, Y As Long
    Dim GbByte() As Byte
    Dim BigByte() As Byte
    
    If GBStr = "" Then
        GBToBig = ""
        Exit Function
    End If
    
    GbByte = StrConv(GBStr, vbFromUnicode)
    Y = UBound(GbByte)
    ReDim BigByte(0 To Y)
    
    For I = 0 To Y
        If I = Y Then
            BigByte(I) = GbByte(I)
            Exit For
        End If
        If GbByte(I) < &HA1 Or GbByte(I + 1) < &HA1 Then
            BigByte(I) = GbByte(I)
        Else
            If GbByte(I) < &HB0 And GbByte(I + 1) >= &HA1 Then
                BigByte(I) = PGbType(GbByte(I) + 6, GbByte(I + 1)).loChar
                BigByte(I + 1) = PGbType(GbByte(I) + 6, GbByte(I + 1)).hiChar
            Else
                BigByte(I) = PGbType(GbByte(I), GbByte(I + 1)).loChar
                BigByte(I + 1) = PGbType(GbByte(I), GbByte(I + 1)).hiChar
            End If
            I = I + 1
        End If
    Next I
    GBToBig = StrConv(BigByte, vbUnicode)
    Erase BigByte
End Function
Private Sub Class_Initialize()
    Dim I As Long
    Dim J As Long
    Dim iLen As Long
    BigData = LoadResData(100, "CUSTOM")    '//读取Big5字库
    GbData = LoadResData(101, "CUSTOM")     '//读取GB字库
    For I = &HA1 To 
        For J = &H40 To 
            PBigType(I, J).loChar = BigData(iLen)
            PBigType(I, J).hiChar = BigData(iLen + 1)
            iLen = iLen + 2
        Next J
    Next I
    iLen = 0
    For I = &HA7 To 
        For J = &HA1 To 
            PGbType(I, J).loChar = GbData(iLen)
            PGbType(I, J).hiChar = GbData(iLen + 1)
            iLen = iLen + 2
        Next J
    Next I
End Sub