#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongLong) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
Private Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
#End If
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
#Else
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
#End If
Private Const LOGPIXELSX = 88 'Pixels/inch in X
Private Const LOGPIXELSY = 90 'Pixels/inch in Y
#If VBA7 Then
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
Const SM_CXVSCROLL = 2
Const SM_CYHSCROLL = 3
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 MSLLHOOKSTRUCT
#If Win64 Then
Pt As LongLong
#Else
Pt As POINTAPI
#End If
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const HC_ACTION = 0
Private Const WH_MOUSE_LL = 14
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_MOUSEMOVE = &H200
Private Const GWL_HINSTANCE = (-6)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060
'
'===================
'HookMouse variables
'===================
Private ControlHooked As Object
Private UserFormControlHooked As Object
#If VBA7 Then
Private plHooking As LongPtr
#Else
Private plHooking As Long
#End If
'
'Scroll step
Private ScrollStep As Integer
Private Const ScrollStep_UserForm_Frame_Page = 16 'Points delta for scrolling UserForm, Frame and Page
'=============
'Box variables
'=============
Private BoxRECT As RECT
Private TabInitializedTexBox() As Object
Private NbInitializedTexBox As Integer
#If Win64 Then
' Copies a POINTAPI into a LongLong. For an API requiring a ByVal POINTAPI parameter,
' this LongLong can be passed in instead. Example API's include WindowFromPoint,
' ChildWindowFromPoint, ChildWindowFromPointEx, DragDetect, and MenuItemFromPoint.
Function PointToLongLong(Point As POINTAPI) As LongLong
Dim ll As LongLong
Dim cbLongLong As LongPtr
cbLongLong = LenB(ll)
' make sure the contents will fit
If LenB(Point) = cbLongLong Then
CopyMemory ll, Point, cbLongLong
End If
PointToLongLong = ll
End Function
#End If
'===================
'HookMouse functions
'===================
Private Sub HookMouse(ByVal Control As Object)
If Not plHooking = 0 Then
Call UnHookMouse
End If
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowshookexa
plHooking = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, 0, 0)
If Not plHooking = 0 Then
Set ControlHooked = Control
End If
End Sub
Private Sub UnHookMouse()
If Not plHooking = 0 Then
UnhookWindowsHookEx plHooking
plHooking = 0
Set ControlHooked = Nothing
End If
End Sub
#If VBA7 Then
Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT
#Else
Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
#End If
Dim udtlParamStuct As MSLLHOOKSTRUCT
#If Win64 Then
CopyMemory ByVal udtlParamStuct, ByVal lParam, LenB(udtlParamStuct)
#Else
CopyMemory VarPtr(udtlParamStuct), ByVal lParam, LenB(udtlParamStuct)
#End If
GetHookStruct = udtlParamStuct
End Function
