让程序获取热键的几种方法的实现

1．通过api函数 GetAsyncKeyState来实现，这种方法最简单，只要用一个api函数即可实现，其效果取决于timer的interval取值，越小灵敏。不过这种方法可能耗费资源比较厉害。
Private Sub Timer1_Timer()
If MyHotKey(vbKeyA) Then
MsgBox "收到热键vbKeyA的消息！"
Me.WindowState = vbNormal
ElseIf MyHotKey(vbKeyF2) Then
MsgBox "收到热键vbKeyF2的消息！"
Me.WindowState = vbNormal
End If
End Sub
Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = GetAsyncKeyState(vKeyCode) < 0
End Function
Private Function GetShift() As Long
Dim TShift As Long
Dim TCtrl As Long
Dim TAlt As Long
'先计算一次清除残留状态
GetAsyncKeyState (16)
GetAsyncKeyState (17)
GetAsyncKeyState (18)
'判断Shift的状态
If GetAsyncKeyState(16) And &H8000 <> 0 Then
TShift = 1
End If
'判断Ctrl的状态
If GetAsyncKeyState(17) And &H8000 <> 0 Then
TCtrl = 2
End If
'判断Alt的状态
If GetAsyncKeyState(18) And &H8000 <> 0 Then
TAlt = 4
End If
GetShift = TShift + TCtrl + TAlt
End Function

2.通过注册热键，并捕获热键的方式，这种方法是在程序运行前通过api函数registerhotkey来注册你的热键，然后在窗口过程里面捕获wm_hotkey消息，具体代码如下：
Option Explicit

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal OldwndProc As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = -4
Public OldwndProc As Long

Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal HotKeyID As Long, ByVal fsModifiers As Long, ByVal vKey As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal HotKeyID As Long) As Long

Public Const WM_HOTKEY = &H312
Public Const WM_NCDESTROY = &H82
Dim HotKeyValue() As Byte ''保存热键信息

Public Function WindowProc(ByVal hwnd As Long, ByVal WindowMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim keyCode As Long
Dim shiftCode As Long
If WindowMsg = WM_HOTKEY Then
keyCode = GetHiWord(lParam)
shiftCode = GetLoWord(lParam)
If keyCode = HotKeyValue(1) And shiftCode = HotKeyValue(0) Then
'Debug.Print "热键被按下 "
End If
End If

WindowProc = CallWindowProc(OldwndProc, hwnd, WindowMsg, wParam, lParam)
End Function

‘截获窗口控制权并注册热键
Public Sub CaptureHotKey(hwnd As Long)
HotKeyValue = GetHotKeyFromSetup()
OldwndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
RegisterHotKey hwnd, 1, HotKeyValue(0), HotKeyValue(1) ' 注册热键 alt + s
End Sub
‘交出窗口控制权并卸载热键
Public Sub UnCaptureHotKey(hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, OldwndProc
UnregisterHotKey hwnd, 1
End Sub
Public Function GetHiWord(nValue As Long) As Long
Dim temp As Long
temp = (nValue And &HFF00)
GetHiWord = temp / &H10000
End Function
Public Function GetLoWord(nValue As Long) As Long
Dim temp As Long
temp = (nValue And &HFF)
GetLoWord = temp
End Function

3.通过键盘钩子来截获按键信息，首先安装全局键盘钩子，截获所有的键盘信息，从中提取你想获取的按键并做出处理，具体代码如下：
Option Explicit
Public hHook As Long
Private Const WH_KEYBOARD = 2
Private Const HC_ACTION = 0
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private 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
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Sub BeginKeyHook()
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, 0, App.ThreadID)
If hHook = 0 Then
MsgBox "Hook失败"
End If
End Sub

Public Sub EndKeyHook()
If hHook <> 0 Then
If UnhookWindowsHookEx(hHook) = 0 Then
MsgBox "Unhook失败"
End If
End If
End Sub

Public Function KeyboardProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If code < 0 Then
KeyboardProc = CallNextHookEx(hHook, code, wParam, lParam)
Exit Function
End If

Debug.Print wParam
If code = HC_ACTION Then
If wParam = &H41 Then
If (lParam And &HC0000000) = &H0 Then
Debug.Print "A键按下"
End If

If (lParam And &HC0000000) = &HC0000000 Then
Debug.Print "A键抬起"
End If

If (lParam And &HC0000000) = &H40000000 Then
Debug.Print "A键持续按下"
End If
End If
End If

KeyboardProc = CallNextHookEx(hHook, code, wParam, lParam)
End Function