使用MoveWindow Win32 API的可移动Access窗体多显示器缩放问题

我基于Access弹出窗体构建完全自定义窗口框架，禁用了窗体边框样式，改用4个形状模拟上下左右边框，同时通过顶部形状的鼠标事件实现窗体拖动。最初使用Form.Move函数，但多显示器环境下存在问题，转而采用Win32 API的MoveWindow和GetPhysicalCursorPos函数。

当三台显示器缩放比例相同时，窗体拖动流畅；但第三台显示器设为300%缩放、另外两台为150%时，窗体在第三台显示器上拖动出现位置大幅跳跃，无法平滑移动。调试输出显示鼠标坐标和窗体左上角坐标出现交替跳转现象。

调试输出 #

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

窗体代码 #

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

模块代码 #

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

解决思路 #

1. 统一坐标空间的缩放转换

   • 问题核心是GetPhysicalCursorPos返回物理像素坐标，而GetWindowRect、MoveWindow默认返回受显示器缩放影响的逻辑坐标，两者空间不匹配导致位置跳转。
   • 调用GetDpiForWindow获取当前窗体所在显示器的DPI值，或用GetMonitorInfo结合GetDpiForMonitor获取对应显示器的缩放比例，将物理坐标转换为逻辑坐标后再执行MoveWindow。

2. 记录鼠标按下时的偏移量

   • 当前代码直接将鼠标位置作为窗体左上角坐标，忽略了鼠标在顶部边框的点击偏移。正确逻辑：
     • 在MouseDown事件中，记录鼠标相对于窗体左上角的偏移量：offsetX = llCoord.Xcoord - myrect.left、offsetY = llCoord.Ycoord - myrect.top
     • 在MouseMove事件中，用当前鼠标坐标减去偏移量，得到窗体应移动到的左上角坐标，避免位置直接绑定导致的跳跃。

3. 替换API函数适配高DPI

   • 改用SetWindowPos替代MoveWindow，同时确保程序开启高DPI感知（可通过修改Access数据库兼容设置，或添加manifest文件标记高DPI支持）。
   • 用GetCursorPos替代GetPhysicalCursorPos，该函数返回逻辑坐标，与GetWindowRect坐标空间一致，无需额外转换。

内容的提问来源于stack exchange，提问作者George Smith