hztosm.cls

ktv场所的包房开房、迎宾、预定管理系统。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cHztoSM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Const ERR_RESULT$ = "?"          ' 函数的错误返回值

Private mGB2312SM$
Private mLoadLibSuccess As Boolean

Private Sub Class_Initialize()
    mGB2312SM$ = ""
    mLoadLibSuccess = False
End Sub

Private Sub Class_Terminate()
    mGB2312SM$ = ""
    mLoadLibSuccess = False
End Sub


'==================================================
' 加载库文件 成功 LoadLibSuccess = True
'            失败 LoadLibSuccess = False
Public Property Get LoadLibSuccess() As Boolean
    LoadLibSuccess = mLoadLibSuccess
End Property
'==================================================


'==================================================
' 方法: LoadLibFile
'
' 功能: 加载库文件
'
' 注意: 将设置加载成功标志 mLoadLibSuccess
'
' 入口: LibFileName     库文件名
'
Public Sub LoadLibFile(ByVal LibFileName$)
    Dim FileNum&
    Dim tmpText$
    
    On Error GoTo ErrLoad:
    FileNum& = FreeFile
    
    Open LibFileName$ For Input As #FileNum
    
    ' 顺序读取库文件,保存到变量 mGB2312SM$ 中
    Do While Not EOF(1)
       Line Input #FileNum, tmpText$
       mGB2312SM$ = mGB2312SM$ & tmpText$
    Loop
    Close #FileNum
    
    ' 加载库文件成功
    mLoadLibSuccess = True
    
    Exit Sub
ErrLoad:
    MsgBox "加载库文件 " & LibFileName$ & " 失败！", vbExclamation, "来自类 cHZtoSM 的错误"
    mGB2312SM$ = ""
    mLoadLibSuccess = False
End Sub
'==================================================


'==================================================
' 函数: HZtoSM
'
' 功能: 返回字符串中第一个字符的声母
'
' 注意: 该函数能处理所有汉字,但需要库文件的支持
'       若待处理的字符并不在库文件中,则函数将返回常数 ERR_RESULT$
'
' 入口: Str     待处理的字符串
'
Public Function HZtoSM$(ByVal str$)
    Dim tmpStr$, sAscii$
    Dim lAsciiU&, lAsciiL&
    Dim fPos&
    
    ' 取出字符串中的第一个字符
    tmpStr$ = Left(str$, 1)
    
    ' 若tmpStr长度为 0 ,则函数无返回值
    If Len(tmpStr$) <= 0 Then Exit Function
    
    ' 返回字符型 ASCII 码
    sAscii$ = Hex(Asc(tmpStr$))
  
 
    If Asc(tmpStr$) >= 48 And Asc(tmpStr$) <= 123 Then
  
        Select Case Asc(tmpStr$)
            Case 48
                HZtoSM$ = "0"
            Case 49
                HZtoSM$ = "1"
            Case 50
                HZtoSM$ = "2"
            Case 51
                HZtoSM$ = "3"
            Case 52
                HZtoSM$ = "4"
            Case 53
                HZtoSM$ = "5"
            Case 54
                HZtoSM$ = "6"
            Case 55
                HZtoSM$ = "7"
            Case 56
                HZtoSM$ = "8"
            Case 57
                HZtoSM$ = "9"
                
            Case 65, 97
                HZtoSM$ = "A"
            Case 66, 98
                HZtoSM$ = "B"
            Case 67, 99
                HZtoSM$ = "C"
            Case 68, 100
                HZtoSM$ = "D"
            Case 69, 101
                HZtoSM$ = "E"
            Case 70, 102
                HZtoSM$ = "F"
            Case 71, 103
                HZtoSM$ = "G"
            Case 72, 104
                HZtoSM$ = "H"
            Case 73, 105
                HZtoSM$ = "I"
            Case 74, 106
                HZtoSM$ = "J"
            Case 75, 107
                HZtoSM$ = "K"
            Case 76, 108
                HZtoSM$ = "L"
            Case 77, 109
                HZtoSM$ = "M"
            Case 78, 110
                HZtoSM$ = "N"
            Case 79, 111
                HZtoSM$ = "O"
            Case 80, 112
                HZtoSM$ = "P"
            Case 81, 113
                HZtoSM$ = "Q"
            Case 82, 114
                HZtoSM$ = "R"
            Case 83, 115
                HZtoSM$ = "S"
            Case 84, 116
                HZtoSM$ = "T"
            Case 85, 117
                HZtoSM$ = "U"
            Case 86, 118
                HZtoSM$ = "V"
            Case 87, 119
                HZtoSM$ = "W"
            Case 88, 120
                HZtoSM$ = "X"
            Case 89, 121
                HZtoSM$ = "Y"
            Case 90, 122
                HZtoSM$ = "Z"
            Case Else
                HZtoSM$ = ERR_RESULT$
        End Select
        Exit Function
    ElseIf Asc(tmpStr$) = 40 Or Asc(tmpStr$) = -23640 Then
        HZtoSM$ = "("
        Exit Function
    ElseIf Asc(tmpStr$) = 41 Or Asc(tmpStr$) = -23639 Then
        HZtoSM$ = ")"
        Exit Function
        
    End If

    If Len(sAscii$) <> 4 Then GoTo ErrChg:
    
    ' 取出字符高字节和低字节
    lAsciiU& = Val("&H" & Left(sAscii$, 2))
    lAsciiL& = Val("&H" & Right(sAscii$, 2))
    
    ' 公式: ( 高两位 - &H81 ) * ( 16 * 12 - 1 ) +
    '       ( 低两位 - &H40 + 1 )
    ' 即可计算出声母对应的位置
    fPos& = (lAsciiU - &H81) * 191 + (lAsciiL& - 63)
    If fPos& < 0 Or fPos& > Len(mGB2312SM) Then GoTo ErrChg:
    
    ' 在库文件查找对应的声母
    HZtoSM$ = UCase(Mid(mGB2312SM, fPos&, 1))
    If (Asc(HZtoSM$) < &H41) Or (Asc(HZtoSM$) > &H90) Then GoTo ErrChg:
    
    Exit Function
ErrChg:
    ' 函数转换错误,返回常数 ERR_RESULT
    HZtoSM$ = ERR_RESULT$
End Function
'==================================================


'==================================================
' 函数: HZtoSMEx
'
' 功能: 返回字符串中每个字符的声母,由函数 HZtoSM 扩展来
'
' 入口: Str     待处理的字符串
'
Public Function HZtoSMEx$(ByVal str$)
    Dim nPos As Long
    
    For nPos = 1 To Len(str$)
        HZtoSMEx$ = HZtoSMEx$ & HZtoSM(Mid(str$, nPos, 1))
    Next
End Function
'==================================================