VB 用WH_KEYBOARD_LL实现全局热键的例子

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