使用 MoveWindow win32 API 监控可移动访问表单的缩放问题

Question

我正在尝试从 Access 弹出表单构建完全自定义的窗口框架。因此，我必须从表单属性表中禁用边框样式属性，并将其替换为用作上、左、右和下边框的 4 个形状。通过这样做，我失去了按住鼠标时拖动/移动表单的能力。结果，必须在顶部形状上使用鼠标向下/向上/移动功能以使其可拖动/可移动。

最初使用内置函数“Form.Move”，但很快意识到这对于多显示器设置来说是一个问题。因此，必须切换并使用 win32 api 才能受益于“MoveWindow”函数以及“GetPhysicalCursorPos”函数。

使用下面提供的代码，如果我的三个显示器从 Windows 设置 > 系统 > 显示选项以相同的百分比缩放，无论屏幕分辨率如何，表单都会完美移动。然而，由于我的第三个显示器的缩放比例为 300%，而另外两个显示器的缩放比例为 150%，一旦表单位于 300% 缩放的显示器上，它的行为就开始变得相当奇怪。对鼠标 x 和 y 坐标以及窗体左上角 x y 坐标的调试打印的进一步调查显示 x、y 位置之间存在巨大跳跃。因此，当我滑动鼠标时，使表单从屏幕的一个位置跳转到另一个位置，而不是平滑过渡。

如果有人能为我提供任何有关如何解决此扩展问题以防止这种情况发生的提示，我将不胜感激。预先感谢！

调试输出：

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

Answer 1

使用 winApi 有一种更简单的方法。

将其放入全局模块中。

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

然后选择您想要移动的任何表格。

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

这将在使用操作系统按下鼠标时移动您的表单。 WM_NCLBUTTON向下