Private Sub Command1_Click()
Dim Str As String, TempStr As String
Dim i As Integer
Str = Text1.Text
TempStr = ""
length = Len(Str)
For i = 1 To length
Select Case Asc(Str)
Case &HB0A1 To &HB0C4: ch = "a"
Case &HB0C5 To &HB2C0: ch = "b"
Case &HB2C1 To &HB4ED: ch = "c"
Case &HB4EE To &HB6E9: ch = "d"
Case &HB6EA To &HB7A1: ch = "e"
Case &HB7A2 To &HB8C0: ch = "f"
Case &HB8C1 To &HB9FD: ch = "g"
Case &HB9FE To &HBBF6: ch = "h"
Case &HBBF7 To &HBFA5: ch = "j"
Case &HBFA6 To &HC0AB: ch = "k"
Case &HC0AC To &HC2E7: ch = "l"
Case &HC2E8 To &HC4C2: ch = "m"
Case &HC4C3 To &HC5B5: ch = "n"
Case &HC5B6 To &HC5BD: ch = "o"
Case &HC5BE To &HC6D9: ch = "p"
Case &HC6DA To &HC8BA: ch = "q"
Case &HC8BB To &HC8F5: ch = "r"
Case &HC8F6 To &HCBF9: ch = "s"
Case &HCBFA To &HCDD9: ch = "t"
Case &HCDDA To &HCEF3: ch = "w"
Case &HCEF4 To &HD188: ch = "x"
Case &HD1B9 To &HD4D0: ch = "y"
Case &HD4D1 To &HD7F9: ch = "z"
Case Else
ch = Left(Str, 1)
End Select
TempStr = TempStr + ch
Str = Mid(Str, 2, Len(Str))
Next
Text2.Text = TempStr
End Sub
Private Sub Command1_Click()
MsgBox pinyin("不到黄河心不死!")
End Sub
Function pinyin(ByVal x As String) As String
On Error Resume Next
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
pinyin = ""
Dim temp As String, i As Long, j As Long
i = 1
Do While i <= Len(x)
If Mid(x, i, 1) = "座" Then temp = "Z"
If InStr(",。“”;:?》《!·¥()", Mid(x, i, 1)) > 0 Then temp = ""
For j = 1 To 23
If Asc(Mid(x, i, 1)) >= Asc(Mid(hanzi, j, 1)) And Asc(Mid(x, i, 1)) < Asc(Mid(hanzi, j + 1, 1)) Then temp = Mid(hanzi, 24 + j, 1)
Next
pinyin = pinyin & " " & temp
i = i + 1
temp = ""
Loop
pinyin = LCase(pinyin)
End Function