我一直在寻找一些允许用户“点击并拖动”以无边界形式移动的代码。我已经在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
要获取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
这可以这样做:
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
基于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”,只需为您的本地更改即可。