汉字信息函数

13849253374

1、汉字检验函数
Function ChnCheck(char As String) As Integer
    '检查字符是否为汉字，是返回1，否返回0
    If Left(char, 1) Like "[一-龥]" Then
        ChnCheck = 1
    Else
        ChnCheck = 0
    End If
End Function
2、汉字区位码函数
Function GB80Code(char As String) As String
    '返回一个汉字的区位码，无区位码返回0000，非汉字返回#Value!
    Dim code, Ubit, Lbit
    If ChnCheck(char) = 0 Then
        GB80Code = "#Value!"
    Else
        code = 65536 + Asc(Left(char, 1))
        Ubit = Int(code / 256 - 160)
        Lbit = code Mod 256 - 160
        If Ubit < 16 Or Ubit > 87 Or Lbit <= 0 Then
            GB80Code = "0000"
        Else
            GB80Code = Ubit & Format(Lbit, "00")
        End If
    End If
End Function
3、汉字类型函数
Function ChsType(ByVal char As String) As Integer
    '返回汉字的类型，一级汉字返回1，二级汉字返回2，非常用字返回0
    If GB80Code(char) = "#Value!" Then
        ChsType = "#Value!"
        Exit Function
    End If
    Dim Ubit
    Ubit = Left(GB80Code(char), 2)
    If Ubit = "00" Then
        ChsType = 0
    ElseIf (Ubit >= 16 And Ubit <= 55) Then
        ChsType = 1
    Else
         ChsType = 2
    End If
End Function
4、汉字U码函数
Function ChnUnicode(char As String) As Long
    '汉字编码位于19968-40869之间，共有20902个
    '一级汉字3755个，二级汉字3008个，其他为非常用字
    Dim i As Long
    For i = 19968 To 40869
        If ChrW(i) = Left(char, 1) Then
            ChnUnicode = i
            Exit Function
        End If
    Next
End Function