Author  

Language  

Operating Systems  

Option Explicit

'API Types
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'API Constants
Const WM_MOVING = 534
Const GWL_WNDPROC = (-4)

'API declarations
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As RECT) As Long
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim OldhWndProc As Long

Private Function OnMove(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As RECT) As Long
    'Handle the OnMove event
    If uMsg = WM_MOVING Then
        'The form is moving!!
        Form1.Label1.Caption = lParam.Left & " " & lParam.Top
        'Insert your code HERE
    End If
    'Call the old WindowProc
    OnMove = CallWindowProc(OldhWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Sub InstallOnMovingEvent(frm As Form)
    'Install the new WindowProc - SubClassing
    OldhWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf OnMove)
End Sub

Public Sub RemoveOnMovingEvent(frm As Form)
    'Restore the original WindowProc
    SetWindowLong frm.hWnd, GWL_WNDPROC, OldhWndProc
End Sub

Private Sub Form_Load()
    InstallOnMovingEvent Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RemoveOnMovingEvent Me
End Sub