Attribute VB_Name = "mMouseHook"
Option Explicit

Private Declare Function SetWindowsHookEx _
 Lib "user32.dll" Alias "SetWindowsHookExA" ( _
    ByVal idHook As Long, _
    ByVal lpfn As Long, _
    ByVal hmod As Long, _
    ByVal dwThreadId As Long _
) As Long

Private Declare Function GetClientRect Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByRef lpRect As RECT _
) As Long

Private Declare Function ScreenToClient Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByRef lpPoint As POINTAPI _
) As Long

Private Declare Function ShowWindow Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal nCmdShow As Long _
) As Long

Private Declare Function CallNextHookEx Lib "user32.dll" ( _
    ByVal hHook As Long, _
    ByVal nCode As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any _
) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32.dll" ( _
    ByVal hHook As Long _
) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long _
) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hWnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Private Const WH_MOUSE As Long = 7
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const WM_NCRBUTTONDOWN As Long = &HA4
Private Const GWL_WNDPROC = (-4)
Private Const WM_DESTROY = &H2&
Private Const WM_ACTIVATEAPP = &H1C
Private Const SW_SHOW As Long = 5

Private hHook As Long
Private hWnd As Long
Private hWndFrm As Long
Private hPrevProc As Long

Public Sub HookMouse(ByVal hWndForm As Long, ByVal hWndFrame As Long)
    UnhookMouse
    hWnd = hWndFrame
    hWndFrm = hWndForm
    hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, 0)
    If hHook Then
        hPrevProc = SetWindowLong(hWndFrm, GWL_WNDPROC, AddressOf WinProc)
        Call ShowWindow(hWnd, SW_SHOW)
    End If
End Sub

Public Sub UnhookMouse()
    If hHook Then
        Call UnhookWindowsHookEx(hHook)
        Call SetWindowLong(hWndFrm, GWL_WNDPROC, hPrevProc)
        Call ShowWindow(hWnd, vbHide)
        hHook = 0
    End If
End Sub

Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MOUSEHOOKSTRUCT) As Long
    Dim p As POINTAPI
    Dim r As RECT
    MouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
    Select Case wParam
        Case WM_LBUTTONDOWN, WM_NCLBUTTONDOWN, WM_NCRBUTTONDOWN, WM_RBUTTONDOWN
            p = lParam.pt
            Call ScreenToClient(hWnd, p)
            Call GetClientRect(hWnd, r)
            If (p.x < 0 Or p.y < 0) Or (p.x > r.Right Or p.y > r.Bottom) Then
                UnhookMouse
            End If
    End Select
End Function

Private Function WinProc(ByVal hW As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_ACTIVATEAPP, WM_DESTROY
            UnhookMouse
    End Select
    WinProc = CallWindowProc(hPrevProc, hW, uMsg, wParam, lParam)
End Function
