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