modgetpy.bas

来自「星级酒店管理系统（附带系统自写控件源码）」· BAS 代码 · 共 75 行

Attribute VB_Name = "modGetPY"

'转换拼音
Public Function GetPyChar(char As String) As String
   
   On Error Resume Next
   
   Dim Tmp As Long
    Tmp = 65536 + Asc(char)
    If Tmp = 53687 Then
       GetPyChar = "s"
       Exit Function
    End If
    If (Tmp >= 45217 And Tmp <= 45252) Then
       GetPyChar = "a"
    ElseIf (Tmp >= 45253 And Tmp <= 45760) Then
       GetPyChar = "b"
    ElseIf (Tmp >= 45761 And Tmp <= 46317) Then
       GetPyChar = "c"
    ElseIf (Tmp >= 46318 And Tmp <= 46825) Then
       GetPyChar = "d"
    ElseIf (Tmp >= 46826 And Tmp <= 47009) Then
       GetPyChar = "e"
    ElseIf (Tmp >= 47010 And Tmp <= 47296) Then
       GetPyChar = "f"
    ElseIf (Tmp >= 47297 And Tmp <= 47613) Then
       GetPyChar = "g"
    ElseIf (Tmp >= 47614 And Tmp <= 48118) Then
       GetPyChar = "h"
    ElseIf (Tmp >= 48119 And Tmp <= 49061) Then
       GetPyChar = "j"
    ElseIf (Tmp >= 49062 And Tmp <= 49323) Then
       GetPyChar = "k"
    ElseIf (Tmp >= 49324 And Tmp <= 49895) Then
       GetPyChar = "l"
    ElseIf (Tmp >= 49896 And Tmp <= 50370) Then
       GetPyChar = "m"
    ElseIf (Tmp >= 50371 And Tmp <= 50613) Then
       GetPyChar = "n"
    ElseIf (Tmp >= 50614 And Tmp <= 50621) Then
       GetPyChar = "o"
    ElseIf (Tmp >= 50622 And Tmp <= 50905) Then
       GetPyChar = "p"
    ElseIf (Tmp >= 50906 And Tmp <= 51386) Then
       GetPyChar = "q"
    ElseIf (Tmp >= 51387 And Tmp <= 51445) Then
       GetPyChar = "r"
    ElseIf (Tmp >= 51446 And Tmp <= 52217) Then
       GetPyChar = "s"
    ElseIf (Tmp >= 52218 And Tmp <= 52697) Then
       GetPyChar = "t"
    ElseIf (Tmp >= 52698 And Tmp <= 52979) Then
       GetPyChar = "w"
    ElseIf (Tmp >= 52980 And Tmp <= 53688) Then
       GetPyChar = "x"
    ElseIf (Tmp >= 53689 And Tmp <= 54480) Then
       GetPyChar = "y"
    ElseIf (Tmp >= 54481 And Tmp <= 62289) Then
       GetPyChar = "z"
     Else '如果不是中文，则不处理
        GetPyChar = char
    End If

End Function

Public Function GetPy(str As String) As String
 
  On Error Resume Next
  For I = 1 To Len(str)
     GetPy = GetPy & GetPyChar(Mid(str, I, 1))
  Next

End Function