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

可以这样做：

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

基于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”，只需为您的本地用户对其进行更改。

拖动鼠标并移动无边界Form Access 2010 VBA

3 个答案: