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 Sub Form_Load()
MsgBox getlayout, vbInformation, "当前输入法"
End Sub
Function getlayout() As String
Dim buff As Long
getlayout = "英文输入法"
buff = GetKeyboardLayout(0) '取得目前的输入法
If ImmIsIME(buff) = 1 Then '中文输入法
getlayout = Space(255)
ImmGetDescription buff, getlayout, Len(getlayout)
End If
End Function
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 Sub Form_Load()
MsgBox getlayout, vbInformation, "当前输入法"
End Sub
Function getlayout() As String
Dim buff As Long
getlayout = "英文输入法"
buff = GetKeyboardLayout(0) '取得目前的输入法
If ImmIsIME(buff) = 1 Then '中文输入法
getlayout = Space(255)
ImmGetDescription buff, getlayout, Len(getlayout)
If InStr(getlayout, "智能ABC") > 0 Or InStr(getlayout, "全拼") > 0 Or InStr(getlayout, "双拼") > 0 Or InStr(getlayout, "拼音") > 0 Then
getlayout = "拼音输入法"
ElseIf InStr(getlayout, "五笔") > 0 Then
getlayout = "五笔输入法"
Else
getlayout = "其他输入法"
End If
End If
End Function
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmIsIME Lib "imm32.dll" (ByVal HKL 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 ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
Private Sub Command1_Click()
Dim ime() As String
GetIMEList ime
Dim i As Integer
For i = 0 To UBound(ime)
Debug.Print ime(i)
Next
End Sub
Sub GetIMEList(ByRef ime() As String)
Dim NoOfKBDLayout As Long, i As Long, j As Long, hCurKBDLayout As Long
Dim hKB(24) As Long, BuffLen As Long
Dim buff As String
Dim RetStr As String
Dim RetCount As Long
buff = String(255, 0)
hCurKBDLayout = GetKeyboardLayout(0)
NoOfKBDLayout = GetKeyboardLayoutList(25, hKB(0))
For i = 1 To NoOfKBDLayout
If ImmIsIME(hKB(i - 1)) = 1 Then
BuffLen = 255
RetCount = ImmGetDescription(hKB(i - 1), buff, BuffLen)
RetStr = Left(buff, RetCount)
Else
RetStr = "English (American)"
End If
ReDim Preserve ime(i - 1) As String
ime(i - 1) = RetStr
Next i
ActivateKeyboardLayout hCurKBDLayout, 0
End Sub
' 获得系统中的输入法列表
' IME() 为返回的输入法列表数组
Sub GetIMEList(ByRef IME() As String)
Dim NoOfKBDLayout As Long, i As Long, j As Long, hCurKBDLayout As Long
Dim hKB(24) As Long, BuffLen As Long
Dim buff As String
Dim RetStr As String
Dim RetCount As Long
buff = String(255, 0)
hCurKBDLayout = GetKeyboardLayout(0)
NoOfKBDLayout = GetKeyboardLayoutList(25, hKB(0))
For i = 1 To NoOfKBDLayout
If ImmIsIME(hKB(i - 1)) = 1 Then
BuffLen = 255
RetCount = ImmGetDescription(hKB(i - 1), buff, BuffLen)
RetStr = Left(buff, RetCount)
Else
RetStr = "English (American)"
End If
ReDim Preserve IME(i - 1) As String
IME(i - 1) = RetStr
Next i
ActivateKeyboardLayout hCurKBDLayout, 0
End Sub