'输入法控制API----------------------------------------------------------------------------------------------
Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long
Public Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Public Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Public Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Public Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Public Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long
Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Public Const KLF_REORDER = &H8Public Function SystemImes() As Variant
'功能:将系统中文输入法名称返回到一个字符串数组中
'返回:如果不存在中文输入法,则返回空串
Dim arrIme(99) As Long, arrName() As String
Dim lngLen As Long, strName As String * 255
Dim lngCount As Long, i As Integer, j As Integer
lngCount = GetKeyboardLayoutList(UBound(arrIme) + 1, arrIme(0))
For i = 0 To lngCount - 1
If ImmIsIME(arrIme(i)) = 1 Then
ReDim Preserve arrName(j)
lngLen = ImmGetDescription(arrIme(i), strName, Len(strName))
arrName(j) = Mid(strName, 1, InStr(1, strName, Chr(0)) - 1)
j = j + 1
End If
Next
SystemImes = IIf(j > 0, arrName, vbNullString)
End FunctionPublic Function OpenIme(Optional strIme As String) As Boolean
'功能:按名称打开中文输入法,不指定名称时关闭中文输入法
Dim arrIme(99) As Long, lngCount As Long, strName As String * 255
lngCount = GetKeyboardLayoutList(UBound(arrIme) + 1, arrIme(0))
Do
lngCount = lngCount - 1
If ImmIsIME(arrIme(lngCount)) = 1 Then
ImmGetDescription arrIme(lngCount), strName, Len(strName)
If InStr(1, Mid(strName, 1, InStr(1, strName, Chr(0)) - 1), strIme) > 0 And strIme <> "" Then
If ActivateKeyboardLayout(arrIme(lngCount), 0) <> 0 Then OpenIme = True
Exit Function
End If
ElseIf strIme = "" Then
If ActivateKeyboardLayout(arrIme(lngCount), 0) <> 0 Then OpenIme = True
Exit Function
End If
Loop Until lngCount = 0
End Function
Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hkl As Long, ByVal flags As Long) As Long
Public Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Public Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Public Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Public Declare Function ImmGetDescription Lib "imm32.dll" Alias "ImmGetDescriptionA" (ByVal hkl As Long, ByVal lpsz As String, ByVal uBufLen As Long) As Long
Public Declare Function ImmIsIME Lib "imm32.dll" (ByVal hkl As Long) As Long
Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Public Const KLF_REORDER = &H8Public Function SystemImes() As Variant
'功能:将系统中文输入法名称返回到一个字符串数组中
'返回:如果不存在中文输入法,则返回空串
Dim arrIme(99) As Long, arrName() As String
Dim lngLen As Long, strName As String * 255
Dim lngCount As Long, i As Integer, j As Integer
lngCount = GetKeyboardLayoutList(UBound(arrIme) + 1, arrIme(0))
For i = 0 To lngCount - 1
If ImmIsIME(arrIme(i)) = 1 Then
ReDim Preserve arrName(j)
lngLen = ImmGetDescription(arrIme(i), strName, Len(strName))
arrName(j) = Mid(strName, 1, InStr(1, strName, Chr(0)) - 1)
j = j + 1
End If
Next
SystemImes = IIf(j > 0, arrName, vbNullString)
End FunctionPublic Function OpenIme(Optional strIme As String) As Boolean
'功能:按名称打开中文输入法,不指定名称时关闭中文输入法
Dim arrIme(99) As Long, lngCount As Long, strName As String * 255
lngCount = GetKeyboardLayoutList(UBound(arrIme) + 1, arrIme(0))
Do
lngCount = lngCount - 1
If ImmIsIME(arrIme(lngCount)) = 1 Then
ImmGetDescription arrIme(lngCount), strName, Len(strName)
If InStr(1, Mid(strName, 1, InStr(1, strName, Chr(0)) - 1), strIme) > 0 And strIme <> "" Then
If ActivateKeyboardLayout(arrIme(lngCount), 0) <> 0 Then OpenIme = True
Exit Function
End If
ElseIf strIme = "" Then
If ActivateKeyboardLayout(arrIme(lngCount), 0) <> 0 Then OpenIme = True
Exit Function
End If
Loop Until lngCount = 0
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货