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))
lor="#008000">'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)
<
/font>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


 
目前有0条回应
Comment
Trackback
你目前的身份是游客,请输入昵称和电邮!