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
Answers
It seems that the issue you're facing is related to how the screen scaling affects the coordinates you obtain when moving the form. Since the screen scaling is different on your monitors, the coordinates may not be translated correctly, resulting in the form jumping around instead of smoothly transitioning.
One possible approach to tackle this issue is to adjust the coordinates obtained based on the screen scaling factor. You can retrieve the scaling factor for each monitor and adjust the coordinates accordingly.
Here's a modified version of your code that attempts to adjust the coordinates based on the screen scaling factor:
Option Compare Database
Option Explicit
Dim moveFormStatus As Boolean
Dim scalingFactorX As Double
Dim scalingFactorY As Double
Private Sub rctgl_formTopBorder_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
moveFormStatus = True
' Get the screen scaling factors
scalingFactorX = GetScalingFactorX()
scalingFactorY = GetScalingFactorY()
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
Dim adjustedX As Long
Dim adjustedY As Long
GetWindowRect Me.hwnd, myrect
GetPhysicalCursorPos llCoord
' Adjust the coordinates based on scaling factor
adjustedX = llCoord.Xcoord / scalingFactorX
adjustedY = llCoord.Ycoord / scalingFactorY
MoveWindow Me.hwnd, adjustedX, adjustedY, myrect.right - myrect.left, myrect.bottom - myrect.top, True
Debug.Print myrect.top & " and " & adjustedX & " .................. " & myrect.left & " and " & adjustedY
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
Private Function GetScalingFactorX() As Double
' Get the horizontal scaling factor for the primary monitor
Dim hWnd As LongPtr
hWnd = 0 ' Primary monitor
GetDpiForMonitor hWnd, 0, scalingFactorX, 0
GetScalingFactorX = scalingFactorX / 100
End Function
Private Function GetScalingFactorY() As Double
' Get the vertical scaling factor for the primary monitor
Dim hWnd As LongPtr
hWnd = 0 ' Primary monitor
GetDpiForMonitor hWnd, 0, 0, scalingFactorY
GetScalingFactorY = scalingFactorY / 100
End Function
In this modified version, GetScalingFactorX and GetScalingFactorY functions retrieve the horizontal and vertical scaling factors for the primary monitor, respectively. These scaling factors are then used to adjust the coordinates obtained from GetPhysicalCursorPos. This adjustment should help in ensuring smooth form movement across monitors with different scaling factors.
