CODEWITHSUNDEEP
vbaformsms-accesswinapiuser32
George Smith
George Smith

Reputation: 505

Monitor Scaling Issue for Moveable Access Form using MoveWindow win32 API

I am trying to build a fully custom window frame from an Access popup form. Therefore, I had to disable the border style property from the form property sheet and replace it with 4 shapes that I use as my top, left, right and bottom borders. By doing so I lost the ability to drag/move the form while holding my mouse. As a result, had to use the mouse down/up/move functions on the top shape to make it draggable/moveable.

Initially used the build in function “Form.Move”, but soon realized that it will be a problem for a multi-monitor setup. Therefore, had to switch and use the win32 api to benefit from the “MoveWindow” function, as well as the “GetPhysicalCursorPos” function.

With the provided code bellow if my three monitors are scaled at the same percentage from the Windows Settings > System > Display option regardless of the screens resolution the form is moving flawlessly. However, as my third monitor is scaled at 300% compared to my other two at 150% once the form is on the 300% scaled monitor it starts to behave rather strangely. Further investigation from my Debug Print of the mouse x and y coordinates as well as top left x y coordinates of my form showed a huge jumps between the x,y positions. Therefore, making the form jump from one place of the screen to another instead of transitioning smoothly when I slide my mouse.

I would be grateful if someone could provide me with any hints on how I can tackle this scaling issue to prevent this from happening. Thanks in advance!

Debug Output:

975 and 1018 .................. 678 and 1463
1463 and 678 .................. 1018 and 975
975 and 1018 .................. 678 and 1463
1463 and 678 .................. 1018 and 975
975 and 1018 .................. 678 and 1463
1463 and 678 .................. 1018 and 975
975 and 1018 .................. 678 and 1463

Form code:

Option Compare Database
Option Explicit

Dim moveFormStatus As Boolean

Private Sub rctgl_formTopBorder_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    moveFormStatus = True
End Sub

Private Sub rctgl_formTopBorder_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If moveFormStatus = True Then
        Dim myrect As RECT
        Dim llCoord As POINTAPI
        GetWindowRect Me.hwnd, myrect
        GetPhysicalCursorPos llCoord
        MoveWindow Me.hwnd, llCoord.Xcoord, llCoord.Ycoord, myrect.right - myrect.left, myrect.bottom - myrect.top, True
        
        Debug.Print myrect.top & " and " & llCoord.Xcoord & " .................. " & myrect.left & " and " & llCoord.Ycoord
    End If
End Sub

Private Sub rctgl_formTopBorder_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    moveFormStatus = False
End Sub

Module Code:

Option Compare Database
Option Explicit

Public Declare PtrSafe Function MoveWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Boolean) As Boolean
Public Declare PtrSafe Function GetWindowRect Lib "user32.dll" (ByVal hwnd As LongPtr, ByRef lpRect As RECT) As Boolean
Public Declare PtrSafe Function GetPhysicalCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Public Type POINTAPI
   Xcoord As Long
   Ycoord As Long
End Type

Public Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type

Upvotes: 5

Views: 199

Answers (1)

AccessWorker
AccessWorker

Reputation: 21

There is a simpler way using winApi.

Put this in a global module.

Public Declare PtrSafe Function ReleaseCapture Lib "user32" () As LongPtr
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HT_CAPTION = 2

Public Function DragMe(handle As Long)
    On Error Resume Next
    ReleaseCapture
    SendMessage handle, WM_NCLBUTTONDOWN , HT_CAPTION , 0
End Function

and then any form you want to move.

Private Sub {control_you_enabling_drag}_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Move this form
    DragMe Me.Hwnd
End Sub

This will move your form while mouse is pressed using the OS. WM_NCLBUTTONDOWN here

Upvotes: 1

Related Questions