通过微软拼音输入法取得汉字拼音
以下为VB代码
'定义类型CANDIDATELIST
Private Type CANDIDATELIST
dwSize As Long
dwStyle As Long
dwCount As Long
dwSelection As Long
dwPageStart As Long
dwPageSize As Long
dwOffset(1) As Long
End Type
'以下的API函数用于输入法操作
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Private Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long
Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Private Declare Function ImmEnumRegisterWord Lib "imm32.dll" Alias "ImmEnumRegisterWordA" (ByVal hkl As Long, ByVal RegisterWordEnumProc As Long, ByVal lpszReading As String, ByVal dw As Long, ByVal lpszRegister As String, lpv As Any) As Long
Private Declare Function ImmEscape Lib "imm32.dll" Alias "ImmEscapeA" (ByVal hkl As Long, ByVal himc As Long, ByVal un As Long, lpv As Any) As Long
Private Declare Function ImmGetContext Lib "imm32.dll" (ByVal hwnd As Long) As Long
Private Declare Function IsDBCSLeadByte Lib "kernel32" (ByVal bTestChar As Byte) As Long
Private Declare Function ImmGetConversionStatus Lib "imm32.dll" (ByVal himc As Long, lpdw As Long, lpdw2 As Long) As Long
'注意这里我们没有用API的原始声明,改用了any,否则出错
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
'常量定义
'下面这几个必须要定义的,不然程序不知道它的值,也就不能实现了
Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2
Private Const MSPY = "微软拼音输入法"
Dim input_local_identifier(1 To 25) As Long
Dim imeName(1 To 25) As String
Dim isMSPY As Long
Dim imeCount As Long
Private Sub Form_load()
Dim i As Long
Dim myName As String
Dim sString As String
Dim sChar As String
Dim bChar() As Byte
numMSPY = 0
'取得输入法数量到imeCount,输入区域标识(输入法句柄)到input_local_identifier数组中,25用来指定缓冲区的大小
imeCount = GetKeyboardLayoutList(25, input_local_identifier(1))
If imeCount Then
For i = 1 To imeCount
myName = String(255, " ")
'ImmEscape
'Accesses capabilities of particular IMEs that are not available through other IME API functions.
'This function is used mainly for country-specific operations
'IME_ESC_IME_NAME
'Retrieves the name of the IME. On input, the lpData parameter must be the pointer to the buffer
'to receive the name. On return, the buffer contains the null-terminated string specifying the IME name.
'For use by the Chinese EUDC editor only; do not use in other applications.
'将输入法的名字存入字串myName中
If ImmEscape(input_local_identifier(i), 0, IME_ESC_IME_NAME, ByVal myName) Then
If myName <> "" Then
'取出空格左侧的字串
myName = Left(myName, InStr(myName, vbNullChar) - 1)
'将输入法名字存入imeName数组中
imeName(i) = myName
'MsgBox myName
'微软拼音输入法的位置
If myName = MSPY Then
numMSPY = i
End If
End If
End If
Next i
End If
sString = "克勒沟中学微机室,微软拼音输入法接口测试程序"
lStrLen = Len(sString)
If lStrLen Then
For i = 1 To lStrLen
'从第i位取1个字符
sChar = Mid(sString, i, 1)
'将字符串由 Unicode 转成系统的缺省码页
bChar = StrConv(sChar, vbFromUnicode)
'检测bChar(0)中是不是含有一个隐含的引导byte
If IsDBCSLeadByte(bChar(0)) Then
Dim lMaxKey As Long
Dim ResultList As Long
'IME_ESC_MAX_KEY
'Return value of the function is the maximum number of key stokes for an EUDC character.
lMaxKey = ImmEscape(input_local_identifier(numMSPY), 0, IME_ESC_MAX_KEY, Null)
'MsgBox lMaxKey 此处显示为8
If lMaxKey Then
'DWORD ImmGetConversionList(
' HKL hKL, =====Input locale identifier
' HIMC hIMC,=====Handle to the input context
' LPCTSTR lpSrc,=====Pointer to a null-terminated character string specifying
' the source of the list.
' LPCANDIDATELIST lpDst,=====Pointer to a CANDIDATELIST structure
' in which the function retrieves the list
' DWORD dwBufLen,=====Size, in bytes, of the output buffer. The application sets
'this parameter to 0 if the function is to return the buffer size required for the
'complete conversion result list.
' UINT uFlag
' );
'GCL_REVERSECONVERSION Source string is the result string.
'The function copies the reading string to the destination buffer
ResultList = ImmGetConversionList(input_local_identifier(numMSPY), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
'MsgBox ResultList 显示为40
If ResultList > 0 Then
Dim bBuffer() As Byte
Dim MaxKey As Long
Dim sBuffer As String
sBuffer = String(255, vbNullChar)
MaxKey = lMaxKey
ResultList = ImmGetConversionList(input_local_identifier(numMSPY), 0, sChar, ByVal sBuffer, ResultList, GCL_REVERSECONVERSION)
If ResultList > 0 Then
Dim bPY() As Byte
Dim j As Long
bBuffer = StrConv(sBuffer, vbFromUnicode)
ReDim bPY(MaxKey * 2 - 1)
For j = bBuffer(24) To bBuffer(24) + MaxKey * 2 - 1
bPY(j - bBuffer(24)) = bBuffer(j)
Next j
sChar = StrConv(bPY, vbUnicode)
If InStr(sChar, vbNullChar) Then
sChar = Trim(Left(sChar, InStr(sChar, vbNullChar) - 1))
End If
'略去最后一位声调,后面加上空格
sChar = Left(sChar, Len(sChar) - 1) & " "
End If
End If
End If
End If
MSPYReverse = MSPYReverse & sChar
Next i
MsgBox MSPYReverse
End If
End Sub
