刚完成一个汉字转拼音的模块,大家测试一下
'语言:Micrisift Visual Basic 6.0
'功能:获取汉字拼音的函数
'作者:黄旭东
'日期:2005-3-21
'版权:CopyRight 2001-2005 By Faib Studio
'网址:http://faib.yeah.net
'邮件:faib920@163.com
Option Explicit
Private Function TenToHex(m As Integer, n As Integer) As String
Dim Q As Integer
Dim r As Integer
TenToHex = ""
Dim bStr As String
Do
Call Divide(m, n, Q, r)
If r > 9 Then
bStr = Chr(55 + r)
Else
bStr = Str(r)
End If
TenToHex = Trim(bStr) & TenToHex
m = Q
Loop While Q <> 0
End Function
Private Sub Divide(num1 As Integer, num2 As Integer, Q As Integer, r As Integer)
If num2 = 0 Then Exit Sub
If num1 / num2 >= 0 Then
Q = Int(num1 / num2)
Else
Q = Int(num1 / num2) + 1
End If
r = num1 Mod num2
End Sub
Public Function ChinesePronounce(Chinese As String, Optional Lower As Boolean = False) As String
Dim ts As String, i As Integer
Dim qm As Integer
Dim wm As Integer
For i = 1 To Len(Chinese)
ts = Mid(Chinese, i, 1)
If Asc(ts) < 0 Then
qm = (Asc(ts) + 65536) \ 256
wm = (Asc(ts) + 65536) Mod 256
ts = TenToHex(qm, 16) & TenToHex(wm, 16)
'一级常用汉字
Select Case ts
Case "B0A1" To "B0C4"
ts = "a"
Case "B0C5" To "B0FE", "B1A1" To "B1FE", "B2A1" To "B2C0"
ts = "b"
Case "B2C1" To "B2FE", "B3A1" To "B3FE", "B4A1" To "B4ED"
ts = "c"
Case "B4EE" To "B4FE", "B5A1" To "B5FE", "B6A1" To "B6E9"
ts = "d"
Case "B6EA" To "B6FE", "B7A1"
ts = "e"
Case "B7A2" To "B7FE", "B8A1" To "B8C0"
ts = "f"
Case "B8C1" To "B8FE", "B9A1" To "B9FD"
ts = "g"
Case "B9FE", "BAA1" To "BAFE", "BBA1" To "BBF6"
ts = "h"
Case "BBF7" To "BBFE", "BCA1" To "BCFE", "BDA1" To "BE40", "BEA1" To "BEFE", "BFA0" To "BFA5"
ts = "j"
Case "BFA6" To "BFFE", "C0A1" To "C0AB"
ts = "k"
Case "C0AC" To "C0FE", "C1A1" To "C1FE", "C2A1" To "C2E7"
ts = "l"
Case "C2E8" To "C2FE", "C3A1" To "C3FE", "C4A1" To "C4C2"
ts = "m"
Case "C4C3" To "C4FE", "C5A1" To "C5B5"
ts = "n"
Case "C5B6" To "C5BD"
ts = "o"
Case "C5BE" To "C5FE", "C6A1" To "C6D9"
ts = "p"
Case "C6DA" To "C740", "C7A1" To "C7FE", "C8A1" To "C8BA"
ts = "q"
Case "C8BB" To "C8F5"
ts = "r"
Case "C8F6" To "C8FE", "C9A1" To "C9FE", "CAA1" To "CAFE", "CBA1" To "CBF9"
ts = "s"
Case "CBFA" To "CBFE", "CCA1" To "CCFE", "CDA1" To "CDD9"
ts = "t"
Case "CDDA" To "CDFE", "CEA1" To "CEF3"
ts = "w"
Case "CEF4" To "CEFE", "CFA1" To "CFFE", "D0A1" To "D0FE", "D1A1" To "D1B8"
ts = "x"
Case "D1B9" To "D1FE", "D2A1" To "D2FE", "D3A1" To "D440", "D4A1" To "D4D0"
ts = "y"
Case "D4D1" To "D4FE", "D5A1" To "D5FE", "D6A1" To "D6FE", "D7A1" To "D7F9"
ts = "z"
Case Else
ts = Ch1(ts)
End Select
Else
End If
ChinesePronounce = ChinesePronounce & ts
Next i
If Not Lower Then ChinesePronounce = UCase(ChinesePronounce)
End Function