VB 用WH_KEYBOARD_LL实现全局热键的例子
_
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
?
