#vb.net #winforms #drag-and-drop
#vb.net #winforms #перетаскивание
Вопрос:
В моем приложении я хочу переместить элемент управления с одной стороны на другую. Этот элемент управления находится внутри tablelayoutpanel. Я хотел бы перетащить элемент управления, который находится внутри панели, а панель находится внутри панели компоновки таблицы, поэтому сначала я удаляю панель формы управления и добавляю элемент управления в форму, после чего я перетаскиваю кнопку управления, чтобы проблема не была четко перетаскиваемой. (это означает, что быстрое перетаскивание не работает должным образом). Мой код
Private Sub HandleDraggableControlMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseDown
Dim target As Control = TryCast(sender, Control)
Dim xWidth, xHeight As Integer
If (Not target Is Nothing) Then
xWidth = sender.Width
xHeight = sender.Height
sender.Parent.Controls.Remove(sender)
sender.Dock = DockStyle.None
sender.Width = xWidth
sender.Height = xHeight
Me.Controls.Add(sender)
Dim pt As Point = Me.PointToClient(target.PointToScreen(Point.Empty))
target.Location = pt
target.Parent = Me
target.BringToFront()
Me.isMouseDown = True
Me.cachedControlPos = pt
Me.cachedMousePos = Control.MousePosition
End If
End Sub
Private Sub HandleDraggableControlMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseMove
If (Me.isMouseDown) Then
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim x As Integer = (Me.cachedControlPos.X (Control.MousePosition.X - Me.cachedMousePos.X))
Dim y As Integer = (Me.cachedControlPos.Y (Control.MousePosition.Y - Me.cachedMousePos.Y))
target.Location = New Point(x, y)
'c2 = (c1 (m2 - m1))
End If
End If
End Sub
Private Sub HandleDraggableControlMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Button2.MouseUp
Me.cachedControlPos = Point.Empty
Me.cachedMousePos = Point.Empty
Me.isMouseDown = False
End Sub
Моя проблема в том, что если быстро перетащить элемент управления, курсор не перемещается, а только перемещается, почему?. Что я делаю не так в моем кодировании?. Как решить проблему?
Ответ №1:
Вам нужно добавить разницу между текущей позицией мыши m2
и кэшированной позицией мыши m1
в кэшированную позицию элемента управления c1
, чтобы получить текущую позицию элемента управления c2
.
c2 = (c1 (m2 - m1))
Что-то вроде этого:
sender.Location = New Point(
(cachedControlLocation.X (e.X - startX)),
(cachedControlLocation.Y (e.Y - startY))
)
Вот пример формы, чтобы показать вам, как это работает:
Public Class Form1
Public Sub New()
Me.InitializeComponent()
Me.ClientSize = New Size(800, 600)
Me.panel1 = New Panel() With {.Bounds = New Rectangle(10, 10, 300, 300), .BackColor = Color.Red}
Me.panel2 = New Panel() With {.Bounds = New Rectangle(10, 10, 200, 200), .BackColor = Color.Green}
Me.panel3 = New Panel() With {.Bounds = New Rectangle(10, 10, 100, 100), .BackColor = Color.Blue}
Me.panel2.Controls.Add(Me.panel3)
Me.panel1.Controls.Add(Me.panel2)
Me.Controls.Add(Me.panel1)
End Sub
Private Sub HandleDraggableControlMouseDown(sender As Object, e As MouseEventArgs) Handles panel1.MouseDown, panel2.MouseDown, panel3.MouseDown
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim pt As Point = Me.PointToClient(target.PointToScreen(Point.Empty))
target.Parent = Me
target.BringToFront()
target.Location = pt
Me.isMouseDown = True
Me.cachedControlPos = pt
Me.cachedMousePos = Control.MousePosition
End If
End Sub
Private Sub HandleDraggableControlMouseMove(sender As Object, e As MouseEventArgs) Handles panel1.MouseMove, panel2.MouseMove, panel3.MouseMove
If (Me.isMouseDown) Then
Dim target As Control = TryCast(sender, Control)
If (Not target Is Nothing) Then
Dim x As Integer = (Me.cachedControlPos.X (Control.MousePosition.X - Me.cachedMousePos.X))
Dim y As Integer = (Me.cachedControlPos.Y (Control.MousePosition.Y - Me.cachedMousePos.Y))
target.Location = New Point(x, y)
'c2 = (c1 (m2 - m1))
End If
End If
End Sub
Private Sub HandleDraggableControlMouseUp(sender As Object, e As MouseEventArgs) Handles panel1.MouseUp, panel2.MouseUp, panel3.MouseUp
Me.cachedControlPos = Point.Empty
Me.cachedMousePos = Point.Empty
Me.isMouseDown = False
End Sub
Private cachedMousePos As Point
Private cachedControlPos As Point
Private isMouseDown As Boolean
Private WithEvents panel1 As Panel
Private WithEvents panel2 As Panel
Private WithEvents panel3 As Panel
End Class
Обновление 1
Важно, чтобы вы установили новое местоположение после того, как изменили родительский элемент и переместили его на передний план.
target.Parent = Me
target.BringToFront()
target.Location = pt '<---
Обновление 2
Итак, я сузил круг поисков до причины этой проблемы, и оказалось, что это Selectable
стиль управления. Вы можете проверить это, создав подкласс класса button и удалив стиль в конструкторе.
Public Class UIButton
Inherits Button
Public Sub New()
MyBase.SetStyle(ControlStyles.Selectable, False)
End Sub
End Class
Итак, как мы можем это исправить? Ну, AFAIK, простого решения нет. Следует ожидать, что выбираемый элемент управления будет обрабатывать сообщения мыши по-другому, чем те, которые не могут. Единственный способ, который я могу придумать (и он может быть грязным), — это подклассифицировать элементы управления и перехватывать сообщения мыши. Следующий код не является окончательным решением, поэтому используйте его с осторожностью.
Public Class UIButton
Inherits Button
Protected Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM.LBUTTONDOWN
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
MyBase.OnMouseDown(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
Exit Select
Case WM.MOVE
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
If (vk = Keys.LButton) Then
MyBase.OnMouseMove(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
End If
Exit Select
Case WM.LBUTTONUP
Dim dw As New DWORD With {.value = m.LParam}
Dim vk As Integer = m.WParam.ToInt32()
MyBase.OnMouseUp(New MouseEventArgs(Windows.Forms.MouseButtons.Left, 0, dw.loword, dw.hiword, 0))
Debug.WriteLine("X={0}, Y={1}", dw.loword, dw.hiword)
Exit Select
End Select
MyBase.WndProc(m)
End Sub
Private Enum WM As Integer
MOVE = amp;H200
LBUTTONDOWN = amp;H201
LBUTTONUP = amp;H202
End Enum
<StructLayout(LayoutKind.Explicit)> _
Private Structure DWORD
<FieldOffset(0)> Public value As Integer
<FieldOffset(0)> Public loword As Short
<FieldOffset(2)> Public hiword As Short
End Structure
End Class
Комментарии:
1. Спасибо за ответ. я хотел бы перетащить элемент управления, который находится внутри панели, а панель находится внутри панели компоновки таблицы, поэтому сначала я удаляю панель формы управления и добавляю элемент управления в форму, после чего я перетаскиваю кнопку управления, чтобы проблема не была четко перетаскиваемой. (это означает, что быстрое перетаскивание не работает должным образом)
2. Можете ли вы обновить свой вопрос с помощью образца формы, в котором указана проблема? Я не могу воспроизвести неудобства с текущим кодом. Кстати, ваше соглашение об именах немного странное. Например, вы действительно ожидаете, что отправителем будет a
KryptonGroupPanel
, если метод названButton_MouseDown
? Кроме того, ваш код полон поздних привязок. Вы должны включить опцию stricton
.3. Спасибо. Но это также я быстро перемещаю курсор, курсор покидает элемент управления
4. проверьте вот так. добавить панель компоновки таблицы, док-станция, заполнить форму. добавить панель в панель компоновки таблицы, после этого добавить кнопку в боковой панели, теперь отметьте это. быстро перемещайте курсор, чтобы курсор покинул элемент управления