You can create a SubClass.
This is kinda tough to explain (so just accept it!), and it may crash if you debug your code and press the End button from the toolbar, or if you use the End statement anywhere in your code.
Form code:
Code:
Option Explicit
Private Sub Form_Load()
Call HookUsUpScotty
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call HookUsDownScotty
End Sub
Public Sub Form_FormMove()
' What??? FormMove???
' Yes!!! Woo hoo!!!
' Just leave it as a Public Sub, will you? This one doesn't like being Private.
End Sub
Don't get excited yet. This lovely module code will work if the above form is called Form1, but that can easily be changed.
Code:
Option Explicit
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_MOVE = &H3
Public Const WM_MOVING = &H216
Dim lpfnPrevWndProc As Long
Public Sub HookUsUpScotty()
lpfnPrevWndProc = SetWindowLong(Form1.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub HookUsDownScotty()
Call SetWindowLong(Form1.hWnd, GWL_WNDPROC, lpfnPrevWndProc)
End Sub
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If (uMsg = WM_MOVE) Or (uMsg = WM_MOVING) Then Call Form1.Form_FormMove
WindowProc = CallWindowProc(lpfnPrevWndProc, hWnd, uMsg, wParam, lParam)
End Function
I HAVEN'T TESTED IT! So I am not sure whether or not it works. But I think it does.
Do you really want to use a DLL?
I always hate distributing any kind of DLL with my applications. If you want that exact same code with no DLL requirement, try this:
Form code:
Code:
Option Explicit
Private Sub Form_Load()
xi = Left
yi = Top
Call InstallHook
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call RemoveHook
End Sub
Module code:
Code:
Option Explicit
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WH_MOUSE = 7
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Dim hHook As Long
Public xi As Long, yi As Long
Public Sub InstallHook()
hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID)
End Sub
Public Sub RemoveHook()
Call UnhookWindowsHookEx(hHook)
End Sub
' The "ByVal lParam As Long" should really be "lParam As MOUSEHOOKSTRUCT"
' but we don't need to access lParam so we can just use a pointer and skip the type declarations.
Public Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case wParam
Case WM_MOUSEMOVE
' Replace Form1 with the naForm1 of the form
' in which you put the code from the beginning of this post.
If Form1.Left <> xi Or Form1.Top <> yi Then
If frKalibrBericht.Visible Then
frKalibrBericht.Left = Form1.Left
frKalibrBericht.Top = Form1.Top
End If
If frKalibrSet.Visible Then
frKalibrSet.Left = Form1.Left
frKalibrSet.Top = Form1.Top
End If
If frStammDatenShow.Visible Then
frStammDatenShow.Left = Form1.Left - frStammDatenShow.Width
frStammDatenShow.Top = Form1.Top
End If
End If
xi = Form1.Left
yi = Form1.Top
Case WM_LBUTTONUP, WM_LBUTTONDOWN
xi = Form1.Left
yi = Form1.Top
End Select
' If lParam wasn't a Long pointer, then the ByVal wouldn't have been here:
MouseProc = CallNextHookEx(hHook, nCode, wParam, ByVal lParam)
End Function