Is there a clever way to handle simulated mousedown dragging with less code? (1 Viewer)

[JMongi]

Currently I am using @isladogs sample code for hiding the Access application window. Related to this is code that simulates dragging around a window using a form header. There are API calls involved. But, I don't think that particular code is relevant. Here IS the relevant code. This code is in the form header on mouse down.

Private Sub FormHeader_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo ErrHandler

   X = ReleaseCapture()
   X = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HT_CAPTION, 0)

Exit Sub

ExitHandler:
'Insert Any Code That Needs To Come After Error Handler Here
Exit Sub

ErrHandler:
Call ErrProcessor
Resume ExitHandler

End Sub

The code itself works great! But, I have to add this code to each graphical element within the header like labels and images. Is there a clever way to minimize the locations for this code? Currently my main dashboard needs 4 such code blocks. Also, each form I create will likely need a similar 4 block section. Just reaching out to see if there are clever VBA options I'm unfamiliar with. Thanks to all the gurus who read this and comment!

 

[theDBguy]

Maybe you could move it to a public function and then simply call it, passing the necessary arguments. Just thinking out loud...

 

[JMongi]

Well, that's a duh moment. I definitely could create a small sub for the mousedown event. That would at least bring it down to 1 line if the err handler is incorporated in the sub.

 

[theDBguy]

Good luck!

 

[isladogs]

@JMongi
I definitely agree with simplifying code as far as possible
You'll see lots of functions in my example app designed to reduced the amount of repeated code to a single line - the procedure name
e.g. HideNavigationPane/MinimizeRibbon/HideTaskbar, HideWindow etc

For example the full code for the HideTaskbar function and associated APIs is

'###############################################
#If VBA7 Then 'A2010 or later 32-bit or 64-bit
    Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal handleW1 As LongPtr, ByVal handleW1InsertWhere As LongPtr, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, ByVal wFlags As Long) As Long
        
#Else 'A2007 or earlier
    Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal handleW1 As Long, ByVal handleW1InsertWhere As Long, ByVal w As Long, _
        ByVal X As Long, ByVal Y As Long, ByVal z As Long, ByVal wFlags As Long) As Long
#End If
'###############################################
 
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40

 Function HideTaskbar()

    handleW1 = FindWindowA("Shell_traywnd", "")
    Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Function

Apart from reducing the amount of code needed each time to one line - HideTaskbar, doing this also means I don't have to remember the full code each time.

 

[arnelgp]

you can create a custom Class and instantiate it on the Load event of your form/forms.
you then move all your code to public function that your class will call.

 

[JMongi]

@arnelgp - That just ran headlong into a void in my programming knowledge.

I know OF classes and objects and such things. But only enough to get myself confused on how they are supposed to work, let alone the actual programming syntax involved. I'll have to do more reading on classes. Thanks for the suggestion!

 

[JMongi]

Oh, and as a bow to the previous discussion, I ended up moving the mousedown code to a public sub. Here is my module code:

Option Compare Database
Option Explicit
Global OldFormTop As Integer        'Used to store form position
Global OldFormLeft As Integer       'Used to store form position

'API to move a form with a mouse down event

Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HT_CAPTION = &H2

#If VBA7 Then
    Public 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
   
    Public Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As Long
#Else
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
   
    Public Declare Function ReleaseCapture Lib "user32.dll" () As Long
#End If

'Call this sub in the mousedown event of the form header and any static elements within the header
Public Sub MouseMove(frm As Form, Button As Integer, Shift As Integer, X As Single, Y As Single)

On Error GoTo ErrHandler

   X = ReleaseCapture()
   X = SendMessage(frm.hWnd, WM_NCLBUTTONDOWN, HT_CAPTION, 0)

Exit Sub

ExitHandler:
'Insert Any Code That Needs To Come After Error Handler Here
Exit Sub

ErrHandler:
Call ErrProcessor
Resume ExitHandler

End Sub
Public Sub OpenFormLocation(frm As Form)

On Error GoTo ErrHandler
Dim Rt As Integer, Dn As Integer, Wd As Integer, Ht As Integer

frm.Painting = False
'Position and Size in TWIPS, 1440 TWIPS per inch
Rt = OldFormLeft + 24
'Debug.Print Me.Name & " " & "Rt= " & Rt
Dn = OldFormTop + 372
'Debug.Print Me.Name & " " & "Dn= " & Dn
Wd = 10 * 1440
'Debug.Print Me.Name & " " & "Wd= " & Wd
Ht = 8.25 * 1440
'Debug.Print Me.Name & " " & "Ht= " & Ht

DoCmd.MoveSize Rt, Dn, Wd, Ht
frm.Painting = True

Exit Sub

ExitHandler:
frm.Painting = True
Exit Sub

ErrHandler:
Call ErrProcessor
Resume ExitHandler

End Sub

So, now my mousedown event code is:

Private Sub FormHeader_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Call modAPIMoveForm.MouseMove(Me, Button, Shift, X, Y)

End Sub