Function getpy(ByVal a As String) '字符码匹配
q = Hex(Asc(a))
Select Case q
Case "B0A1" To "B0C4"
getpy = "a"
Case "B0C5" To "B2C0"
getpy = "b"
Case "B2C1" To "B4ED"
getpy = "c"
Case "B4EE" To "B6E9"
getpy = "d"
Case "B6EA" To "B7A1"
getpy = "e"
Case "B7A2" To "B8C0"
getpy = "f"
Case "B8C1" To "B9FD"
getpy = "g"
Case "B9FE" To "BBF6"
getpy = "h"
Case "BBF7" To "BFA5"
getpy = "j"
Case "BFA6" To "C0AB"
getpy = "k"
Case "C0AC" To "C2E7"
getpy = "l"
Case "C2E8" To "C4C2"
getpy = "m"
Case "C4C3" To "C5B5"
getpy = "n"
Case "C5B6" To "C5BD"
getpy = "o"
Case "C5BE" To "C6D9"
getpy = "p"
Case "C6DA" To "C8BA"
getpy = "q"
Case "C8BB" To "C8F5"
getpy = "r"
Case "C8F6" To "CBF9"
getpy = "s"
Case "CBFA" To "CDD9"
getpy = "t"
Case "CDDA" To "CEF3"
getpy = "w"
Case "CEF4" To "D188"
getpy = "x"
Case "D189" To "D4D0"
getpy = "y"
Case "D4D1" To "D7F9"
getpy = "z"
Case Else
getpy = "?" '生僻字返回通配符
End Select
End Function
Private Sub Command1_Click()
Strs = Text1.Text '取出文本内容
Strslen = Len(Strs) '取出文本长度
mcode = "" '存放助记符
If Strslen < 0 Then '如果为空不执行操作
Text2 = ""
Else
For i = 1 To Strslen '循环取出单个字符
temp = Mid(Strs, i, 1) '判断是否是数字或字母
If Asc(temp) > 48 And Asc(temp) < 58 Or Asc(temp) > 64 And Asc(temp) < 91 Or Asc(temp) > 96 And Asc(temp) < 123 Then
mcode = mcode + UCase(temp) '原样输出数字或字母
ElseIf Asc(temp) < 0 Then '如果是汉字则调用getpy函数,累加助记符
mcode = mcode + UCase(getpy(temp))
End If
Next i
Text2 = mcode '输出助记符
End If
End Sub