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

 

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