Перетащите мышь и переместите доступ к форме без границ 2010 VBA

Question

Я некоторое время искал какой-нибудь код, который позволил бы пользователю «щелкать и перетаскивать», чтобы перемещаться по безграничной форме. Я добился этого в VB.Net и C # в Windows Forms и, как я считаю, исторически делал это в Excel (хотя я не могу вспомнить код). Кажется, я не могу отработать переводы в Access VBA, в первую очередь потому, что «левый» метод не может быть применен к объекту Form в Private Sub (я думаю?):

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

Оптимизация, основанная на Ответ Эрика А : Еще немного проще, и вы можете видеть движение окна при его перетаскивании.

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

Это все в моей статье: Окно сообщений в стиле модерн / Metro и поле ввода для Microsoft Access 2013 +

Полный код также на GitHub : VBA.ModernBox