позволить конечному пользователю переместить элемент управления - PullRequest
2 голосов
/ 06 апреля 2011

Я нашел хороший образец Здесь , но у меня есть несколько проблем с ним. 1. Он не помещает элемент управления в правильное положение, где мышь остановилась, потому что элемент управления большой.

  1. Его можно вытолкнуть за пределы экрана ... Я хочу, чтобы он оставался в пределах экрана.

Это мой код:

   Public Sub Form1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyControl.MouseMove
    If Not _capturingMoves Then
        Return
    End If
    X = e.X
    Y = e.Y
End Sub

Public Sub Form1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyControl.MouseUp
    If _capturingMoves Then
        ' Do any final placement
        MyControl.Location = New Point(X, Y)
        _capturingMoves = False
    End If
End Sub

1 Ответ

6 голосов
/ 06 апреля 2011

Я написал что-то вроде этого для перетаскивания div на веб-странице ...

Общий подход состоял в том, чтобы сохранить координаты в mousedown, получить координаты при наведении мыши и сместить местоположение объекта на разницу.

Вот пример кода:

Я создал класс DragInfo, который хранит начальные координаты мыши и начальное местоположение. Затем я сохраняю одного из этих парней в элементе управления Tag для события mousedown:

Public Class DragInfo
    Public Property InitialMouseCoords As Point
    Public Property InitialLocation As Point

    Public Sub New(ByVal MouseCoords As Point, ByVal Location As Point)
        InitialMouseCoords = MouseCoords
        InitialLocation = Location
    End Sub

    Public Function NewLocation(ByVal MouseCoords As Point) As Point
        Dim loc As New Point(InitialLocation.X + (MouseCoords.X - InitialMouseCoords.X), InitialLocation.Y + (MouseCoords.Y - InitialMouseCoords.Y))
        Return loc
    End Function
End Class

Мой тестовый элемент управления - это просто панель, которую я вставил из панели инструментов. Это может быть что угодно. Вот мои обработчики событий mousedown, mousemove и mouseup для панели (Panel1):

Private Sub Panel1_MouseDown(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseDown
    Panel1.Tag = New DragInfo(Form.MousePosition, Panel1.Location)
End Sub

Private Sub Panel1_MouseMove(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseMove
    If Panel1.Tag IsNot Nothing Then
        Dim info As DragInfo = CType(Panel1.Tag, DragInfo)
        Dim newLoc As Point = info.NewLocation(Form.MousePosition)
        If Me.ClientRectangle.Contains(New Rectangle(newLoc, Panel1.Size)) Then Panel1.Location = newLoc
    End If
End Sub

Private Sub Panel1_MouseUp(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseUp
    Panel1.Tag = Nothing
End Sub

Вот, пожалуйста! Это работает. Обратите внимание, что метод mousemove проверяет, находится ли элемент управления в прямоугольнике клиента формы.

Или, более общий путь:

Private Sub MakeDraggable(ByVal Control As Control)
    AddHandler Control.MouseDown, Sub(sender As Object, e As MouseEventArgs) StartDrag(Control)
    AddHandler Control.MouseMove, Sub(sender As Object, e As MouseEventArgs) Drag(Control)
    AddHandler Control.MouseUp, Sub(sender As Object, e As MouseEventArgs) StopDrag(Control)
End Sub
Private Sub StartDrag(ByVal Control As Control)
    Control.Tag = New DragInfo(Form.MousePosition, Control.Location)
End Sub
Private Sub Drag(ByVal Control As Control)
    If Control.Tag IsNot Nothing AndAlso TypeOf Control.Tag Is DragInfo Then
        Dim info As DragInfo = CType(Control.Tag, DragInfo)
        Dim newLoc As Point = info.NewLocation(Form.MousePosition)
        If Me.ClientRectangle.Contains(New Rectangle(newLoc, Control.Size)) Then Control.Location = newLoc
    End If
End Sub
Private Sub StopDrag(ByVal Control As Control)
    Control.Tag = Nothing
End Sub

Теперь вы можете просто использовать MakeDraggable(Panel1) или любой другой элемент управления, чтобы сделать его перетаскиваемым!

Редактировать: оба примера теперь удерживают элемент управления от перетаскивания за пределы.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...