感谢半空烟雨的回复,对我们很有帮助!!
但是这段代码有些问题 对于非汉字会转换成“zun”,还有就是待转换的汉子是“zuo”的时候都会转换成“zun”
我把修正的地方说一下啊:
1、Const PY_Combination As Long = 395行改为Const PY_Combination As Long = 396
2、Public Sub InitDictinary()函数中最后一行加入 PY_Spell(396) = "N\A": PY_Num(396) = 0 一行,否则不能判别“zuo”
3、GetPY函数内改为
Dim PA As Long, PZ As Long
Dim PM As Long, Bingo As Boolean
If Len(PY_Spell(0)) = 0 Then InitDictinary
If ChnAsc >= 0 Then
GetPY = ""
Else
PA = 0: PZ = PY_Combination
PM = PZ / 2: Bingo = False
While (Not Bingo And (PZ - PA) > 1)
Select Case ChnAsc
Case Is < PY_Num(PM)
PZ = PM: PM = PA + (PZ - PA) / 2
Case Is = PY_Num(PM)
Bingo = True
Case Is > PY_Num(PM)
PA = PM: PM = PA + (PZ - PA) / 2
End Select
Wend
GetPY = PY_Spell(IIf(Bingo, PM, PA))
End If
这样,输入的asc不是中文的时候就不转换了
'---------------------------------------------------------------------------------------
' Procedure : cmd_Convert_Click
' DateTime : 2007-4-21 10:49
' Author : MaDaHa
' Input : t_Input TextBox
' Output : lblOut label
' Purpose : 将输入框中的汉字字符转换为汉语拼音码
'---------------------------------------------------------------------------------------
Private Sub cmd_Convert_Click()
Dim I As Long, S As String
For I = 1 To Len(t_Input)
S = S & GetPY(Asc(Mid(t_Input, I, 1))) & " "
Next
lblOut = t_Input & "的汉语拼音为:" & vbCrLf & S
'---------------------------------------------------------------------------------------
' Procedure : GetPY
' DateTime : 2007-4-21 10:45
' Author : MaDaHa
' Input : 汉字 Asc 编码 Integer
' Output : 汉语拼音码 String
' Purpose : 二分法检索拼音码
'---------------------------------------------------------------------------------------
'
Public Function GetPY(ChnAsc As Integer) As String
Dim PA As Long, PZ As Long
Dim PM As Long, Bingo As Boolean
While (Not Bingo And (PZ - PA) > 1)
Select Case ChnAsc
Case Is < PY_Num(PM)
PZ = PM: PM = PA + (PZ - PA) / 2
Case Is = PY_Num(PM)
Bingo = True
Case Is > PY_Num(PM)
PA = PM: PM = PA + (PZ - PA) / 2
End Select
Wend