一个用WH_KEYBOARD_LL实现全局热键的例子

QUOTE:

Option Explicit
Private Declare Function SetWindowsHookEx _
                Lib "user32" _
                Alias "SetWindowsHookExW" (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
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 Sub CopyMemory _
                Lib "kernel32" _
                Alias "RtlMoveMemory" (ByVal Destination As Long, _
                                       ByVal Source As Long, _
                                       ByVal Length As Long)
                                       
Private Type KBDLLHOOKSTRUCT
        VKCode As Long
        scanCode As Long
        flags As Long
        time As Long
        dwExtraInfo As Long
End Type

Private Const VK_LSHIFT = &HA0
Private Const VK_RSHIFT = &HA1
Private Const VK_LCONTROL = &HA2
Private Const VK_RCONTROL = &HA3
Private Const VK_LMENU = &HA4 'MENU=ALT
Private Const VK_RMENU = &HA5
Private Const HC_ACTION = &H0
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Dim hHook As Long

Dim CtrlIsPressed As Boolean
Dim ShiftIsPressed As Boolean
Dim AltIsPressed As Boolean

Public Type HotKeyInfo
        IncludeCtrl As Boolean
        IncludeShift As Boolean
        IncludeAlt As Boolean
        UserKey As String * 1
End Type

Private Type UsrHotKeyInfo
        UserInfo As HotKeyInfo
        IsInUse As Boolean
End Type

Dim savedHotKeys() As UsrHotKeyInfo

Public Sub HotKey_Process(ByVal KeyVKCode As Long, ByVal nAction As Long)
        If ((KeyVKCode = VK_LCONTROL) Or (KeyVKCode = VK_RCONTROL)) Then
                CtrlIsPressed = (nAction = WM_KEYDOWN)
                GoTo SubProc_Exit
        End If
        If ((KeyVKCode = VK_LSHIFT) Or (KeyVKCode = VK_RSHIFT)) Then
                ShiftIsPressed = (nAction = WM_KEYDOWN)
                GoTo SubProc_Exit
        End If
        If ((KeyVKCode = VK_LMENU) Or (KeyVKCode = VK_RMENU)) Then
                AltIsPressed = (nAction = WM_KEYDOWN)
                GoTo SubProc_Exit
        End If
        If (nAction = WM_KEYUP) Then Call HotKeyProc(PressedHotKeyIndex(KeyVKCode))
        'CtrlIsPressed = False: ShiftIsPressed = False: AltIsPressed = False
SubProc_Exit:
        
End Sub

'ret val=index of hotkey
Public Function AddHotKey(ByRef addKeyInfo As HotKeyInfo) As Integer
        Dim newInd As Integer
        Dim I As Integer
        Dim bFound As Boolean: bFound = False
        For I = LBound(savedHotKeys) To UBound(savedHotKeys)
                If (savedHotKeys(I).IsInUse = False) Then
                        newInd = I: bFound = True
                        Exit For
                End If
        Next
        If (Not bFound) Then
                newInd = UBound(savedHotKeys) + 1
                ReDim Preserve savedHotKeys(newInd)
        End If
        With savedHotKeys(newInd)
                .UserInfo = addKeyInfo
                .UserInfo.UserKey = UCase(.UserInfo.UserKey)
                .IsInUse = True
        End With
End Function

Public Sub ClearHotKeyList()
        Erase savedHotKeys
        ReDim savedHotKeys(0)
End Sub

Public Sub DelHotKey(ByVal nIndex As Integer)
        savedHotKeys(nIndex).IsInUse = False
End Sub

Private Function PressedHotKeyIndex(ByVal VKCode As Long) As Integer
        PressedHotKeyIndex = -1
        Dim newInd As Integer
        Dim I As Integer
        Dim bFound As Boolean: bFound = False
        Dim strPressedKey As String: strPressedKey = UCase(Chr(VKCode))
        For I = LBound(savedHotKeys) To UBound(savedHotKeys)
                With savedHotKeys(I)
               
                        If (.IsInUse = True) Then
                                If ((.UserInfo.IncludeAlt = AltIsPressed) And _
                                    (.UserInfo.IncludeCtrl = CtrlIsPressed) And _
                                    (.UserInfo.IncludeShift = ShiftIsPressed) And _
                                    (.UserInfo.UserKey = strPressedKey)) _
                                Then
                                        PressedHotKeyIndex = I: GoTo Func_Exit
                                End If
                        End If
               
                End With
        Next
        
Func_Exit:

End Function

Private Sub HotKeyProc(ByVal nIndex As Integer)

        If (nIndex > -1) Then

                With frmFunctionSelect

                        Select Case nIndex

                                Case 0 'HotKey 0 Pressed
                                'what can i do for u?
                        End Select

                End With

        End If

End Sub

Public Function DisableKbdHook() As Boolean
        'Debug.Print "hHook: "; hHook
        hHook = UnhookWindowsHookEx(hHook) - 1
        DisableKbdHook = (hHook = 0)
End Function

Public Function EnableKbdHook() As Boolean
        'Debug.Print "hHook: "; hHook
        If (hHook <= 0) Then hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
        EnableKbdHook = (hHook <> 0)
End Function

Private Function LowLevelKeyboardProc(ByVal nCode As Long, _
                                      ByVal wParam As Long, _
                                      ByVal lParam As Long) As Long

        If (nCode <> HC_ACTION) Then
                LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
                Exit Function
        End If
        
        Call HotKey_Process(GetKeyVKCode(lParam), wParam)

        LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam): GoTo Exit_Func
Exit_Func:
End Function

Private Function GetKeyVKCode(ByVal memAddr As Long) As Long
        Dim curHs As KBDLLHOOKSTRUCT
        Call CopyMemory(VarPtr(curHs), ByVal memAddr, Len(curHs))
        GetKeyVKCode = curHs.VKCode
End Function

Private Function GetKeyScanCode(ByVal memAddr As Long) As Long
        Dim curHs As KBDLLHOOKSTRUCT
        Call CopyMemory(VarPtr(curHs), ByVal memAddr, Len(curHs))
        GetKeyScanCode = curHs.scanCode
End Function