怎么取得汉字的拼音？
请问怎么用代码取得汉字的拼音？ 问题点数：20、回复次数：8Top
1 楼conrad_wan（pineapple）回复于 2005-08-02 10:59:51 得分 2
没做过~~~我的思路是去找现有输入法是否有接口可用，如果没有只能自己建库了。声母、韵母库，然后是常用汉字库及其对应的声母、韵母索引。工程浩大啊~~~Top
2 楼FlyFlypig（）回复于 2005-08-02 11:06:44 得分 0
应该有简单的方法，继续请教！！Top
3 楼WM_JAWIN（失业,找工作中...）回复于 2005-08-02 11:08:27 得分 2
在我的QB时代我做过.
方法同楼上的.
我当时用的UCDOS的拼音库.将它转换成二进制数据格式(自己认证的数据库格式*_^ ),查找时非常快.
几行数学运算就可找到相应该的拼音了Top
4 楼Wat5（Wat5）回复于 2005-08-02 11:11:38 得分 5
Option Explicit
Const GCL_CONVERSION = 1
Const GCL_REVERSECONVERSION = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2
Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Type CANDIDATELIST
dwSize As Long
dwStyle As Long
dwCount As Long
dwSelection As Long
dwPageStart As Long
dwPageSize As Long
dwOffset(0) As Long
End Type
Private Declare Function ImmGetContext Lib "imm32" ( _
ByVal hwnd As Long _
) As Long
Private Declare Function ImmReleaseContext Lib "imm32" ( _
ByVal hwnd As Long, _
ByVal hIMC As Long _
) As Long
Private Declare Function ImmGetConversionList Lib "imm32" Alias "ImmGetConversionListW" ( _
ByVal hKL As Long, _
ByVal hIMC As Long, _
ByRef lpSrc As Byte, _
ByRef lpDst As Any, _
ByVal dwBufLen As Long, _
ByVal uFlag As Long _
) As Long
Private Declare Function GetKeyboardLayout Lib "user32" ( _
ByVal idThread As Long _
) As Long
Private Declare Function GetKeyboardLayoutList Lib "user32" _
(ByVal nBuff As Long, _
ByRef lpList As Long) As Long
Private Declare Function ImmEscape Lib "imm32.dll" _
Alias "ImmEscapeA" _
(ByVal hKL As Long, _
ByVal hIMC As Long, _
ByVal un As Long, _
ByRef lpv As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" ( _
ByRef strString As Any _
) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion(127) As Byte
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" ( _
ByRef VersionInfo As OSVERSIONINFO _
) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, _
ByRef Source As Any, _
ByVal Length As Long _
)
Public Function ReverseConversionNew(hwnd As Long, strSource As String) As String
Dim bySource() As Byte
Dim i As Integer
Dim arrKeyLayout() As Long
Dim strIME As String
Dim hIMC As Long
Dim hKL As Long
Dim lngSize As Long
Dim lngOffset As Long
Dim iKeyLayoutCount As Integer
Dim byCandiateArray() As Byte
Dim CandiateList As CANDIDATELIST
Dim byWork() As Byte
Dim lngResult As Long
Const BUFFERSIZE As Integer = 255
Dim osvi As OSVERSIONINFO
Dim isChineseIme As Boolean
If strSource = "" Then Exit Function
'OS判別
osvi.dwOSVersionInfoSize = Len(osvi)
lngResult = GetVersionEx(osvi)
If osvi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
'WindowsNT系:Unicode字符集
bySource = strSource
ReDim Preserve bySource(UBound(bySource) + 2)
Else
'Windows95系
bySource = StrConv(strSource, vbFromUnicode)
ReDim Preserve bySource(UBound(bySource) + 1)
End If
hIMC = ImmGetContext(hwnd)
ReDim arrKeyLayout(BUFFERSIZE) As Long
strIME = Space(BUFFERSIZE)
iKeyLayoutCount = GetKeyboardLayoutList(BUFFERSIZE, arrKeyLayout(0))
isChineseIme = False
For i = 0 To iKeyLayoutCount - 1
If ImmEscape(arrKeyLayout(i), hIMC, IME_ESC_IME_NAME, ByVal strIME) Then
If Trim(UCase("微软拼音输入法")) = UCase(Replace(Trim(strIME), Chr(0), "")) Then
isChineseIme = True
Exit For
End If
End If
Next i
If isChineseIme = False Then Exit Function
hKL = arrKeyLayout(i)
' hKL = GetKeyboardLayout(0)
lngSize = ImmGetConversionList(hKL, hIMC, bySource(0), Null, 0, GCL_REVERSECONVERSION)
If lngSize > 0 Then
ReDim byCandiateArray(lngSize)
lngSize = ImmGetConversionList(hKL, hIMC, bySource(0), byCandiateArray(0), lngSize, _
GCL_REVERSECONVERSION)
MoveMemory CandiateList, byCandiateArray(0), Len(CandiateList)
If CandiateList.dwCount > 0 Then
lngOffset = CandiateList.dwOffset(0)
ReverseConversionNew = MidB(byCandiateArray, lngOffset + 1, _
lstrlen(byCandiateArray(lngOffset)) * 2)
End If
End If
lngResult = ImmReleaseContext(hwnd, hIMC)
End Function
需要微软拼音输入法,
调用方式:
Debug.Print ReverseConversionNew(Form1.hwnd, "中国")
结果:
zhong1 guo2Top
5 楼hot1kang1（网站制作,系统开发,记得-http://3q2008.Com）回复于 2005-08-02 11:31:39 得分 1
好东西 :) 收藏Top
6 楼JayJay（）回复于 2005-08-02 11:59:21 得分 3
运行成功了吗？Top
7 楼Wat5（Wat5）回复于 2005-08-02 13:03:50 得分 2
成功Top
8 楼JayJay（）回复于 2005-08-02 13:41:00 得分 5
Public Function py(mystr As String) As String
If Asc(mystr) < 0 Then
If Asc(Left(mystr, 1)) < Asc("啊") Then
py = "0"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啊") And Asc(Left(mystr, 1)) < Asc("芭") Then
py = "A"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("芭") And Asc(Left(mystr, 1)) < Asc("擦") Then
py = "B"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("擦") And Asc(Left(mystr, 1)) < Asc("搭") Then
py = "C"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("搭") And Asc(Left(mystr, 1)) < Asc("蛾") Then
py = "D"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("蛾") And Asc(Left(mystr, 1)) < Asc("发") Then
py = "E"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("发") And Asc(Left(mystr, 1)) < Asc("噶") Then
py = "F"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("噶") And Asc(Left(mystr, 1)) < Asc("哈") Then
py = "G"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哈") And Asc(Left(mystr, 1)) < Asc("击") Then
py = "H"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("击") And Asc(Left(mystr, 1)) < Asc("喀") Then
py = "J"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("喀") And Asc(Left(mystr, 1)) < Asc("垃") Then
py = "K"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("垃") And Asc(Left(mystr, 1)) < Asc("妈") Then
py = "L"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("妈") And Asc(Left(mystr, 1)) < Asc("拿") Then
py = "M"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("拿") And Asc(Left(mystr, 1)) < Asc("哦") Then
py = "N"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("哦") And Asc(Left(mystr, 1)) < Asc("啪") Then
py = "O"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("啪") And Asc(Left(mystr, 1)) < Asc("期") Then
py = "P"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("期") And Asc(Left(mystr, 1)) < Asc("然") Then
py = "Q"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("然") And Asc(Left(mystr, 1)) < Asc("撒") Then
py = "R"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("撒") And Asc(Left(mystr, 1)) < Asc("塌") Then
py = "S"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("塌") And Asc(Left(mystr, 1)) < Asc("挖") Then
py = "T"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("挖") And Asc(Left(mystr, 1)) < Asc("昔") Then
py = "W"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("昔") And Asc(Left(mystr, 1)) < Asc("压") Then
py = "X"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("压") And Asc(Left(mystr, 1)) < Asc("匝") Then
py = "Y"
Exit Function
End If
If Asc(Left(mystr, 1)) >= Asc("匝") Then
py = "Z"
Exit Function
End If
Else
If UCase(mystr) <= "Z" And UCase(mystr) >= "A" Then
py = UCase(Left(mystr, 1))
Else
py = mystr
End If
End If
End Function
Private Sub command1_click()
Dim a As Integer
Label1.Caption = ""
a = Len(Text1.Text)
For i = 1 To a
Label1.Caption = Label1.Caption & py(Mid(Text1.Text, i, 1))
Next i
End SubTop
