拖动鼠标并移动无边框表单Access 2010 VBA

Question

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

Me.Left

如果没有这个，我正在努力翻译代码，那么还有另一种方式，可能是使用Windows API调用或只是Form事件来实现这一点吗？我真的很想用无边框表格看起来那么好看！

任何帮助非常感谢。

以下是适用的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

要获取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 2

这可以这样做：

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

Answer 3

基于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”，只需为您的本地更改即可。