拖动鼠标和移动无边界表单访问 2010 VBA

Question

我一直在寻找一些允许用户“单击并拖动”以在无边框表单中移动的代码。我已经在 VB.Net 和 Windows 窗体中的 C# 中实现了这一点，并且我相信，历史上是在 Excel 中完成的（尽管我不记得代码）。我似乎无法翻译成 Access VBA，主要是因为“left”方法不能应用于 Private Sub 中的 Form 对象（我认为？）：

Me.Left

没有这个，我很难翻译代码，那么还有其他方法，也许是通过 Windows API 调用或只是表单事件来实现这一点？我真的很想用尽所有可能性，因为无边界表单看起来很不错！

非常感谢任何帮助。

这是有效的 VB.Net 版本：

Dim dragForm As Boolean
Dim xDrag As Integer
Dim yDrag As Integer

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
    dragForm = True
    xDrag = Windows.Forms.Cursor.Position.X - Me.Left
    yDrag = Windows.Forms.Cursor.Position.Y - Me.Top
End Sub

Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
    If dragForm Then
        Me.Top = Windows.Forms.Cursor.Position.Y - yDrag
        Me.Left = Windows.Forms.Cursor.Position.X - xDrag
    End If
End Sub

Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
    dragForm = False 
End Sub

到目前为止，这是我重新编写的尝试：

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim xx As Long
Dim yy As Long

xx = Me.Left + X - xDrag
yy = Me.Top + Y - yDrag
Me.Left = xx
Me.Top = yy
moveFrm = False

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim xx As Long
Dim yy As Long

If moveFrm = True Then
     xx = Me.Left + X - xDrag
     yy = Me.Top + Y - yDrag
     Me.Left = xx
     Me.Top = yy
End If

End Sub

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

    moveFrm = True
    xDrag = X
    yDrag = Y

End Sub

Answer 1

基于Erik A's answer的优化：还是简单一点，拖动的时候可以看到窗口在移动。

Dim moveFrm As Boolean
Dim xMouseDown As Long
Dim yMouseDown As Long

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

    moveFrm = True
    xMouseDown = X
    yMouseDown = Y

End Sub

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

    If moveFrm Then
        Me.Move Me.WindowLeft + X - xMouseDown, Me.WindowTop + Y - yMouseDown
    End If

End Sub

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

    moveFrm = False

End Sub

注意：在德语中，详细信息部分是“Detailbereich”，只需根据您当地的情况进行更改即可。

Answer 2

要在Access中获取表单位置，需要使用.WindowLeft和WindowTop。

要设置表单位置，需要使用.Move

Form_MouseDown 和Form_MouseUp 仅在您单击不是详细信息部分的表单部分时注册。

Dim moveFrm As Boolean
Dim xDrag As Long
Dim yDrag As Long


Private Sub Detail_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim xx As Long
Dim yy As Long

xx = Me.WindowLeft + x - xDrag
yy = Me.WindowTop + y - yDrag
Me.Move xx, yy
moveFrm = False

End Sub

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim xx As Long
Dim yy As Long

If moveFrm = True Then
     xx = Me.WindowLeft + x - xDrag
     yy = Me.WindowTop + y - yDrag
     Me.Move xx, yy
End If

End Sub

Private Sub Detail_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    moveFrm = True
    xDrag = x
    yDrag = y

End Sub

Answer 3

可以这样做：

Private Sub FormMove(Button As Integer, Shift As Integer, x As Single, Y As Single, _
    ByVal MouseAction As MouseAction)

' Move the form by dragging the title bar or the label upon it.

    ' WindowLeft and WindowTop must be within the range of Integer.
    Const TopLeftMax        As Single = 2 ^ 15 - 1
    Const TopLeftMin        As Single = -2 ^ 15

    ' Statics to hold the position of the form when mouse is clicked.
    Static PositionX        As Single
    Static PositionY        As Single
    ' Static to hold that a form move is enabled.
    Static MoveEnabled      As Boolean

    Dim WindowTop           As Single
    Dim WindowLeft          As Single

    ' The value of MoveEnable indicates if the call is from
    ' mouse up, mouse down, or mouse move.

    If MouseAction = MouseMove Then
        ' Move form.
        If MoveEnabled = True Then
            ' Form move in progress.
            If Button = acLeftButton Then
                ' Calculate new form position.
                WindowTop = Me.WindowTop + Y - PositionY
                WindowLeft = Me.WindowLeft + x - PositionX
                ' Limit Top and Left.
                If WindowTop > TopLeftMax Then
                    WindowTop = TopLeftMax
                ElseIf WindowTop < TopLeftMin Then
                    WindowTop = TopLeftMax
                End If
                If WindowLeft > TopLeftMax Then
                    WindowLeft = TopLeftMax
                ElseIf WindowLeft < TopLeftMin Then
                    WindowLeft = TopLeftMax
                End If
                Me.Move WindowLeft, WindowTop
            End If
        End If
    Else
        ' Enable/disable form move.
        If Button = acLeftButton Then
            ' Only left-button click accepted.
            'If MoveEnable = True Then
            If MouseAction = MouseDown Then
                ' MouseDown.
                ' Store cursor start position.
                PositionX = x
                PositionY = Y
                MoveEnabled = True
            Else
                ' MouseUp.
                ' Stop form move.
                MoveEnabled = False
            End If
        End If
    End If

End Sub

例如：

Private Sub BoxTitle_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

    ' Enable dragging of the form.
    Call FormMove(Button, Shift, x, Y, MouseDown)

End Sub

都在我的文章里：Modern/Metro style message box and input box for Microsoft Access 2013+

完整代码也在 GitHub：VBA.ModernBox