Option Explicit
Private Const EVENT_SYSTEM_MOVESIZESTART As Long = &HA
Private Const EVENT_SYSTEM_MOVESIZEEND = &HB
Private Const WINEVENT_OUTOFCONTEXT = 0
#If VBA7 Then
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As LongLong, ByVal lpfnWinEventProc As LongLong, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As LongPtr) As Long
#Else
Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal EventMin As Long, ByVal EventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
#End If
Private pRunningHandles As Collection
Public Function StartEventHook() As Long
If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
StartEventHook = SetWinEventHook(EVENT_SYSTEM_MOVESIZESTART, EVENT_SYSTEM_MOVESIZEEND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
pRunningHandles.Add StartEventHook
End Function
#If VBA7 Then
Public Sub StopEventHook(lHook As LongPtr)
#Else
Public Sub StopEventHook(lHook As Long)
#End If
Dim LRet As Long
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
End Sub
Public Sub StartHook()
StartEventHook
End Sub
Public Sub StopAllEventHooks()
Dim vHook As Variant
#If VBA7 Then
Dim lHook As LongPtr
#Else
Dim lHook As Long
#End If
For Each vHook In pRunningHandles
#If VBA7 Then
lHook = CLngPtr(vHook)
#Else
lHook = CLng(vHook)
#End If
StopEventHook lHook
Next vHook
End Sub
#If VBA7 Then
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
#Else
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
#End If
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen.
On Error Resume Next
Dim thePID As Long
If LEvent = EVENT_SYSTEM_MOVESIZESTART Then
GetWindowThreadProcessId Application.hWnd, thePID
If thePID = GetCurrentProcessId Then
Application.OnTime Now, "Event_MoveStart"
End If
ElseIf LEvent = EVENT_SYSTEM_MOVESIZEEND Then
GetWindowThreadProcessId Application.hWnd, thePID
If thePID = GetCurrentProcessId Then
Application.OnTime Now, "Event_MoveEnd"
End If
End If
On Error GoTo 0
End Function
Public Sub Event_MoveStart()
Debug.Print "Event_MoveStart"
End Sub
Public Sub Event_MoveEnd()
Debug.Print "Event_MoveEnd"
End Sub