拖动鼠标并移动 Borderless Form Access 2010 VBA

Question

我一直在寻找一些允许用户 'click and drag' 在无边界表单中移动的代码。我已经在 VB.Net 和 C# 中以 Windows 形式实现了这一点，而且我相信，历史上是在 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

可以这样做：

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 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

在的基础上进行了优化：还是比较简单，可以看到window边拖边动

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"，只需根据您的当地情况进行更改即可。

拖动鼠标并移动 Borderless Form Access 2010 VBA

Drag Mouse and Move Borderless Form Access 2010 VBA

ms-access

vba

ms-access-2010