前端之家收集整理的这篇文章主要介绍了
vb键盘钩子，
前端之家小编觉得挺不错的，现在分享给大家，也给大家做个参考。
如果按键其中一个不是控制键的话，VB中必须用键盘钩子才能实现判断按下的是哪两个按键
建议不要研究用VB本身完成上述任务，使用API是很简单的
可以参考一些使用全局钩子的程序，下面是我写的一些代码，此全局钩子的代码改编自一位VB达人的钩子代码，此达人在VB不可能实现钩子的一片喊声中写出了下面的代码，没有使用DLL，虽然不知道他的名字，但是很感激他在我很茫然的时候给了我信心，那就是对VB的狂热！
努力吧兄弟，你会发现VB的天空是很美丽的！！！～～～
1。公用代码写在模块中
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long,ByVal lpfn As Long,ByVal hmod As Long,ByVal dwThreadId As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long,ByVal nCode As Long,ByVal wParam As Long,lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long,ByVal lpProcName As String) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long,ByVal hWndInsertAfter As Long,ByVal X As Long,ByVal Y As Long,ByVal cx As Long,ByVal cy As Long,ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any,ByVal lpvSource As Long,ByVal cbCopy As Long)
Public Type KEYMSGS
vKey As Long '虚拟码 (and &HFF)
sKey As Long '扫描码
flag As Long '键按下：128 抬起：0
time As Long 'Window运行时间
End Type
Public Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long,ByVal lpBuffer As String,ByVal nSize As Long) As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public strKeyName As String * 255
Public keyMsg As KEYMSGS
Public Const Alt_Down = &H20
'消息
Public Const HC_ACTION = 0
Public Const HC_SYSMODALOFF = 5
Public Const HC_SYSMODALON = 4
'键盘消息
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_SYSKEYDOWN = &H104
Public Const WM_SYSKEYUP = &H105
Public hHook As Long
2。钩子事件处理代码，写在模块中
'键盘钩子
Public Function CallKeyHookProc(ByVal code As Long,ByVal lParam As Long) As Long
Dim lKey As Long
Dim strKeyName As String * 255
Dim strLen As Long
Dim 虚拟码 As Integer
'On Error GoTo CallKeyHookProcErr:
If code = HC_ACTION Then
CopyMemory keyMsg,lParam,LenB(keyMsg)
lKey = keyMsg.sKey And &HFF '扫描码
lKey = lKey * 65536
strLen = GetKeyNameText(lKey,strKeyName,250)
虚拟码 = CInt(Format(keyMsg.vKey And &HFF,"0"))
Select Case wParam
Case WM_SYSKEYDOWN,WM_KEYDOWN:
GUN_CTRL.Text1.Text = "键名:" + Left(strKeyName,strLen) + " 虚拟码:" + Format(keyMsg.vKey And &HFF,"0") + " 扫描码:" + Format(lKey / 65536,"0")
'GUN_CTRL.Text2.Text = ""
'If (GetKeyState(vbKeyControl) And &H8000) Then
' GUN_CTRL.Text2.Text = GUN_CTRL.Text2.Text + "Ctrl "
'End If
'
' If (keyMsg.flag And Alt_Down) <> 0 Then
' GUN_CTRL.Text2.Text = GUN_CTRL.Text2.Text + "Alt "
' End If
'
' If (GetKeyState(vbKeyShift) And &H8000) Then
' GUN_CTRL.Text2.Text = GUN_CTRL.Text2.Text + "Shift"
' End If
Select Case 虚拟码
Case 移动键(0)
移动标志(0) = True: CallKeyHookProc = 1
Case 移动键(1)
移动标志(1) = True: CallKeyHookProc = 1
Case 移动键(2)
移动标志(2) = True: CallKeyHookProc = 1
Case 移动键(3)
移动标志(3) = True: CallKeyHookProc = 1
Case 移动键(4)
移动标志(4) = True: CallKeyHookProc = 1
Case 移动键(5)
移动标志(5) = True: CallKeyHookProc = 1
Case 旋转键(0)
旋转标志(0) = True: CallKeyHookProc = 1
Case 旋转键(1)
旋转标志(1) = True: CallKeyHookProc = 1
Case 旋转键(2)
旋转标志(2) = True: CallKeyHookProc = 1
Case 旋转键(3)
旋转标志(3) = True: CallKeyHookProc = 1
Case 旋转键(4)
旋转标志(4) = True: CallKeyHookProc = 1
Case 旋转键(5)
旋转标志(5) = True: CallKeyHookProc = 1
Case 120
Call LoadKeySetting("F9"): CallKeyHookProc = 1
Case 121
Call LoadKeySetting("F10"): CallKeyHookProc = 1
Case 122
Call LoadKeySetting("F11"): CallKeyHookProc = 1
Case 123
Call LoadKeySetting("F12"): CallKeyHookProc = 1
Case 192 '数字键左边那个键 工作行程 <----> 辅助行程
If 当前行程状态 = 1 Then
GUN_CTRL.工作_辅助行程Timer.Enabled = True: CallKeyHookProc = 1
ElseIf 当前行程状态 = 2 Then
GUN_CTRL.工作_辅助行程Timer.Enabled = True: CallKeyHookProc = 1
End If
Case 49,97,35 '数字键1,小键盘1
If 当前行程状态 = 0 Then
ElseIf 当前行程状态 = 1 Then
Else
End If
Case 50,98,40 '数字键2,小键盘2
If 当前行程状态 = 0 Then
ElseIf 当前行程状态 = 1 Then
Else
End If
Case 13 '回车 焊接
If 当前行程状态 = 1 Then
GUN_CTRL.焊接Timer.Enabled = True: CallKeyHookProc = 1
ElseIf 当前行程状态 = 0 Then
GUN_CTRL.焊接Timer.Enabled = True: CallKeyHookProc = 1
End If
End Select
Case WM_SYSKEYUP,WM_KEYUP:
Select Case 虚拟码
Case 移动键(0)
移动标志(0) = False
Case 移动键(1)
移动标志(1) = False
Case 移动键(2)
移动标志(2) = False
Case 移动键(3)
移动标志(3) = False
Case 移动键(4)
移动标志(4) = False
Case 移动键(5)
移动标志(5) = False
Case 旋转键(0)
旋转标志(0) = False
Case 旋转键(1)
旋转标志(1) = False
Case 旋转键(2)
旋转标志(2) = False
Case 旋转键(3)
旋转标志(3) = False
Case 旋转键(4)
旋转标志(4) = False
Case 旋转键(5)
旋转标志(5) = False
End Select
End Select
End If
If 移动标志(0) + 移动标志(1) + 移动标志(2) + 移动标志(3) + 移动标志(4) + 移动标志(5) = 0 Then
GUN_CTRL.移动时钟.Enabled = False
Else
GUN_CTRL.移动时钟.Enabled = True
End If
If 旋转标志(0) + 旋转标志(1) + 旋转标志(2) + 旋转标志(3) + 旋转标志(4) + 旋转标志(5) = 0 Then
GUN_CTRL.旋转时钟.Enabled = False
Else
GUN_CTRL.旋转时钟.Enabled = True
End If
'CallKeyHookProc = 1
CallKeyHookProcErr:
If code <> 0 Then
CallKeyHookProc = CallNextHookEx(0,code,wParam,lParam)
End If
End Function
3。窗体中两个按钮分别完成开始钩子和结束钩子
Private Sub Form_Unload(Cancel As Integer)
If hHook > 0 Then Call UnhookWindowsHookEx(hHook)
End Sub
Private Sub HookCommand_Click()
'&H20A
hHook = SetWindowsHookEx(2,AddressOf MyKBHook,App.ThreadID)
End Sub
Private Sub HookUnCommand_Click()
If hHook > 0 Then Call UnhookWindowsHookEx(hHook)
End Sub
