Detecting when a form is moved 1

[Panthaur]

Does anyone know how to detect when a form itself is moved (NOT resized) by clicking on the caption bar and dragging? I tried every event that I could find with no luck.

Any help would be appreciated!

Thanks,
Pan

 

[mmilan]

You're probably reduced to using the API to go after the WM_Move message...

Not sure how to do about it though...

mmilan

 

[Panthaur]

Thanks for your input mmilan. If anyone has the API call for it, i'd appreciate it.

Thanks,
Wade

 

[mmilan]

Another solution (easier, though not as neat as the API) would be to implement a timer control on the form, with a suitably low interval. In the Timer event you could compare the form's left and top properties, and then decide if the form has moved.

This is a very messy solution though - you really don't want a timer if it can be avoided. You could really do with someone who eats, sleeps and sh!ts API.

Paging Dr. Strongm ...

 

[DrJavaJoe]

Goto

http://www.freevbcode.com

and do a search for event spy, it's an excellent project.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."

 

[Panthaur]

You know, I already have a number of timers running in the window, so I guess it wouldn't be that bad to use the timer method... obviously, I would rather have the program catch the window move and save the dang form!!

Hopefully, Strongm can give me some feedback.

Pan

 

[Norris68]

You could hook the main window procedure using the SetWindowLong API call and trap the WM_WINDOWPOSCHANGED message. It's very involved though and requires expert coding skills so I'm not going to attempt to post any code here at the moment.

I have got some code that hooks the window message function to trap mouse events so that I could stop the annoying default popup menu that occurs when you right-click a text box. If you are interested I'll post up the module I've got, but I'm afraid I haven't got time to hack it into shape for your purposes.

 

[mmilan]

I'm interested...

 

[DrJavaJoe]

If you download the project that I referred to it has an example of exactly what you are looking for.

"Two strings walk into a bar. The first string says to the bartender: 'Bartender, I'll have a beer. u.5n$x5t?*&4ru!2[sACC~ErJ'. The second string says: 'Pardon my friend, he isn't NULL terminated'."

 

[Norris68]

OK, here goes. The code hooks the window messages for each textbox individually. Within the Form_Load event we hook the messages and remember to unhook them in the Form_Unload event - otherwise you will crash the IDE very quickly! The form has a public sub (HandleMouseHook) to handle the mouse messages. You will need to hook the messages for the main form as opposed to each textbox as my application does. I will also have to leave it to you to deconstruct the WINDOWPOS structure that is passed in lParam (that contains the position information).

Here is the public module that does the hooking & unhooking and handles the window messages ...

Option Explicit

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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
   As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_WNDPROC = -4

Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203

Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206

Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209

Public Const WM_MOUSEWHEEL = &H20A
Public Const WM_MOUSEHOVER = &H2A1
Public Const WM_MOUSELEAVE = &H2A3
Public Const WM_CAPTURECHANGED = &H215

Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_SHIFT = &H4
Public Const MK_CONTROL = &H8
Public Const MK_MBUTTON = &H10

Private Type MouseHook
    hwnd As Long            'Hwnd of the control
    FriendlyName As String  'Name to be passed in ParentForms HandleMouse sub
    ParentForm As Form      'The form the control belongs to
    OldWindowProc As Long   'The old WindowProc pointer
End Type

Private MouseHooks() As MouseHook   'Where we keep all the hooks

Public Sub HookMouse(hwnd As Long, FriendlyName As String, ParentForm As Form)
'Add An Item To the Array
Dim A As Long
'In-line Error Handling
On Error Resume Next
A = UBound(MouseHooks())    'Generates Error If Not Initialised
If Err.Number <> 0 Then     'If Error Occurred
    Err.Clear               'Clear It
    On Error GoTo 0         'Reinstate Default Error Handling
    ReDim MouseHooks(0)     'Initialise The Array
Else
    On Error GoTo 0         'Reinstate Default Error Handling
    If MouseHooks(0).hwnd <> 0 Then 'If hWnd Of First Item Not Zero (Unused)
        ReDim Preserve MouseHooks(UBound(MouseHooks()) + 1) 'Add An Item
    End If
End If
'And Hook The WindowProc
With MouseHooks(UBound(MouseHooks()))
    .hwnd = hwnd
    .FriendlyName = FriendlyName
    Set .ParentForm = ParentForm
    .OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf MouseHookWindowProc)
    'Debug.Print FriendlyName & &quot; Hooked As Item &quot; & UBound(MouseHooks())
End With
End Sub

Public Sub UnhookMouse(hwnd As Long)
Dim Temp As Long
Dim A As Long
Dim FriendlyName As String

'As We Can't Reset The Array To No Items, Set The hWnd Of Item 0 To 0 When Empty
If MouseHooks(0).hwnd <> 0 Then
    For A = 0 To UBound(MouseHooks())
        If MouseHooks(A).hwnd = hwnd Then
            With MouseHooks(A)
                'Unhook WindowProc
                Temp = SetWindowLong(.hwnd, GWL_WNDPROC, .OldWindowProc)
                FriendlyName = .FriendlyName
            End With
            Temp = A
            Exit For
        End If
    Next A
    'Debug.Print FriendlyName & &quot; Unhooked As Item &quot; & Temp
    'If Not Last One In Array (We Can't Un-Dim An Array !)
    If UBound(MouseHooks()) > 0 Then
        'Shuffle Down To Fill Gap
        For A = Temp To UBound(MouseHooks()) - 1
            MouseHooks(A) = MouseHooks(A + 1)
        Next A
        'And Remove Last Item
        ReDim Preserve MouseHooks(UBound(MouseHooks()) - 1)
    Else
        MouseHooks(0).hwnd = 0
    End If
End If
End Sub

Function MouseHookWindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim Temp As Long
Dim A As Long

'Find the Item
On Error Resume Next
If MouseHooks(0).hwnd <> 0 Then
    For A = 0 To UBound(MouseHooks())
        If MouseHooks(A).hwnd = hw Then
            With MouseHooks(A)
                Select Case uMsg
                'WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MBUTTONDOWN, WM_MBUTTONUP,
                Case WM_RBUTTONDOWN, WM_RBUTTONUP, WM_RBUTTONDBLCLK:
                    'Get The Parent Form To Do Its Thing
                    .ParentForm.HandleMouseHook .FriendlyName, uMsg, wParam, lParam
                    'Return Zero (As We Should For Mouse Up/Down Messages)
                    MouseHookWindowProc = 0
                Case Else
                    'Call the original handler for any non-handled messages
                    MouseHookWindowProc = CallWindowProc(.OldWindowProc, hw, uMsg, wParam, lParam)
                End Select
            End With
            Exit For
        End If
    Next A
End If
End Function

 

[Norris68]

Anyway, I'm off home now so I'll have to leave you to it. I'll flag this thread.

 

[Panthaur]

DrJavaJoe,

I downloaded the eventctl application (ocx) that you suggestions, but I managed to crash it instantly due to a bug in the OCX. I actually sent my sample project to the author to show him how I broke it. Maybe he will post a fix for it.

Anyway, I think I'll have to try the code above.

Thanks,
Pan

 

[strongm]

>You could hook the main window procedure using the SetWindowLong API call

More commonly referred to as subclassing.

>unhook them in the Form_Unload event

Not quite as important with subclassing as it is with, say, keyboard hooks

>It's very involved though and requires expert coding skills

Oh, I dunno...

You'll need a form with a text box. Add the following code:
[tt]
Option Explicit

Private Sub Form_Load()
SubClassWindow Me.hwnd
End Sub
[/tt]
Now add a module, and add the following code:
[tt]
Option Explicit

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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Const GWL_WNDPROC = (-4)
Private Const WM_WINDOWPOSCHANGED = &H47

Private OriginalWindowProc As Long

Public Sub SubClassWindow(hwnd As Long)
OriginalWindowProc = GetWindowLong(hwnd, GWL_WNDPROC)
SetWindowLong hwnd, GWL_WNDPROC, AddressOf myWindowProc
End Sub

Public Function myWindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wMsg = WM_WINDOWPOSCHANGED Then
Form1.Text1 = "Changed position"
End If

myWindowProc = CallWindowProc(OriginalWindowProc, hwnd, wMsg, wParam, lParam)
End Function

 

[mmilan]

Thanks for that...

I've used call back functions before, but never hooks. I'll be having a good read of all the posts.

mmilan

 

[SBendBuckeye]

Hello strongm,

I added a timer named Timer1 to the form with the following code so I could see it working:

Option Explicit

Private Sub Form_Load()
SubClassWindow Me.hwnd
Timer1.Interval = 1000
End Sub

Private Sub Timer1_Timer()
If Text1.Text = "Changed position" Then
Text1.Text = "Unchanged"
End If
End Sub

This is a new arena for me so if you wouldn't mind sharing your expertise I have a few questions as follow:

1. Is the name SubClassWindow significant in and of itself or is it just a descriptive name for your sub

2. In your sub SubClassWindow, it appears you are retrieving and saving the current callback function and then changing it to your own function named myWindowProc - is my understanding correct and am I using terms properly

3. In your function myWindowProc, it appears you react to a specific message and then pass it along via the saved original value

4. Assuming I am reasonably close on the above, how would I turn off subclassing if I no longer needed to use it or do I just quit checking for the message in myWindowProc

Thanks for your help!

Have a great day!

j2consulting@yahoo.com

 

[strongm]

1. No, not significant. Call it what you like

2. Yep, that's more-or-less right; every window has a window procdure, essentially a message processing loop. The window structure holds a pointer to that procedure, and we replace it with a pointer to our own function.

It is worth pointing out here that you can call your callback procedure whatever you like but it must follow the declaration template (i.e all the parameters) as given in the code above, else watch your program crash...

3. Given that a) Windows works by passing messages an b) that we've just replace the normal message processing loop in a window for one of our own it follows that the window we are playing with is likely tostop working as we would expect it to - unless we pass messages on to the original message loop.

The example in this thread is just a simple one, in that we intercept a message, make a response, and then pass it on (along with all other messages) for normal processing. There are often occasions where you want to respond to a message without passing it on the default processing, or where you might want to make some changes to some of the accompanying parameters (in wParam and lParam) before passing them in (fixing a minimum or maximum size for a window is a good example of the latter)

4. Just me being lazy for this example. Yes, you'd generally want to put the old procedure back:

SetWindowLong hwnd, GWL_WNDPROC, OriginalWindowProc

 

[vladk]

strongm,

I tried your code. It appears that it produces the "Changed position" message even when I tried to resize the form, not to move.

Vlad