75 lines
2.5 KiB
QBasic
75 lines
2.5 KiB
QBasic
|
Attribute VB_Name = "ex_MSHook"
|
||
|
|
' =========== Microsoft event hooks ================
|
||
|
|
' Shared module version: 20220703
|
||
|
|
' Tested in:
|
||
|
|
' Depends on:
|
||
|
|
' Required reference:
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Private Declare PtrSafe Function FindWindow Lib "user32" _
|
||
|
|
Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
|
||
|
|
Private Declare PtrSafe Function GetWindowLong Lib "user32" _
|
||
|
|
Alias "GetWindowLongA" (ByVal nHwnd As Long, ByVal nIndex As Long) As Long
|
||
|
|
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
|
||
|
|
|
||
|
|
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
|
||
|
|
Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
|
||
|
|
Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
|
||
|
|
(ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As LongPtr
|
||
|
|
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
|
||
|
|
|
||
|
|
Public Type LongPoint
|
||
|
|
x_ As Long
|
||
|
|
y_ As Long
|
||
|
|
End Type
|
||
|
|
|
||
|
|
Public Type MSLLHOOKSTRUCT
|
||
|
|
point_ As LongPoint
|
||
|
|
direction_ As Long
|
||
|
|
flags_ As Long
|
||
|
|
time_ As Long
|
||
|
|
info_ As Long
|
||
|
|
End Type
|
||
|
|
|
||
|
|
Public g_mouseHook As LongPtr
|
||
|
|
Public g_hookData As MSLLHOOKSTRUCT
|
||
|
|
Public g_hookCallback As Object
|
||
|
|
Public g_hookCBFunction As String
|
||
|
|
|
||
|
|
Private Const HC_ACTION = 0
|
||
|
|
Private Const WH_MOUSE_LL = 14
|
||
|
|
Private Const WM_MOUSEWHEEL = &H20A
|
||
|
|
Private Const GWL_HINSTANCE = (-6)
|
||
|
|
|
||
|
|
Private Const USERFORM_CLASSNAME = "ThunderDFrame"
|
||
|
|
|
||
|
|
Public Function HookEnable(oCallback As Object, sCallbackFunc$)
|
||
|
|
If g_mouseHook > 0 Then _
|
||
|
|
Exit Function
|
||
|
|
Set g_hookCallback = oCallback
|
||
|
|
g_hookCBFunction = sCallbackFunc
|
||
|
|
g_mouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf HookProcess, _
|
||
|
|
GetWindowLong(FindWindow(USERFORM_CLASSNAME, g_hookCallback.Caption), GWL_HINSTANCE), 0)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function HookDisable()
|
||
|
|
If g_mouseHook = 0 Then _
|
||
|
|
Exit Function
|
||
|
|
Call UnhookWindowsHookEx(g_mouseHook)
|
||
|
|
g_mouseHook = 0
|
||
|
|
Set g_hookCallback = Nothing
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Function HookProcess(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MSLLHOOKSTRUCT) As LongPtr
|
||
|
|
If nCode <> HC_ACTION Or wParam <> WM_MOUSEWHEEL Then
|
||
|
|
HookProcess = CallNextHookEx(0, nCode, wParam, ByVal lParam)
|
||
|
|
Exit Function
|
||
|
|
End If
|
||
|
|
|
||
|
|
If GetForegroundWindow <> FindWindow(USERFORM_CLASSNAME, g_hookCallback.Caption) Then _
|
||
|
|
Exit Function
|
||
|
|
|
||
|
|
Call CallByName(g_hookCallback, g_hookCBFunction, VbMethod, lParam.direction_)
|
||
|
|
HookProcess = True
|
||
|
|
End Function
|