Управление не перемещается при перетаскивании

#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 ? Кроме того, ваш код полон поздних привязок. Вы должны включить опцию strict on .

3. Спасибо. Но это также я быстро перемещаю курсор, курсор покидает элемент управления

4. проверьте вот так. добавить панель компоновки таблицы, док-станция, заполнить форму. добавить панель в панель компоновки таблицы, после этого добавить кнопку в боковой панели, теперь отметьте это. быстро перемещайте курсор, чтобы курсор покинул элемент управления