座標の指定について (ID:143189)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

DragDropもMouseイベントと同じでした↓
（ボタンじゃなくてラベルとピクチャーボックスになってますが）

Private mousePoint As Point
    Dim dragBox As Rectangle = Rectangle.Empty
    Dim Xsave As Integer, Ysave As Integer

Private Sub form1_DragOver(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles MyBase.DragOver
        If e.AllowedEffect = DragDropEffects.Move Then
            e.Effect = DragDropEffects.Move
        End If
    End Sub

Private Sub form1_DragDrop(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles MyBase.DragDrop
        If e.Data.GetDataPresent(GetType(PictureBox)) And (e.Effect = DragDropEffects.Move) Then
            Dim pict As PictureBox = e.Data.GetData(GetType(PictureBox))
            Dim pos As Point = New Point(e.X, e.Y)
            pos = Me.PointToClient(pos)
            'pos = pos - New Point(pict.Width \ 2, pict.Height \ 2)
            pos = New Point(pos.X - Xsave, pos.Y - Ysave)
            pict.Location = pos
            
        End If
    End Sub

Private Sub pic1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pic1.MouseDown
        Dim sz As Size = SystemInformation.DragSize
        dragBox = New Rectangle(e.X - sz.Width / 2, e.Y - sz.Height / 2, sz.Width, sz.Height)
        Xsave = e.X : Ysave = e.Y

If e.Button = MouseButtons.Left Then
            mousePoint = New Point(e.X, e.Y)
        End If

End Sub

Private Sub pic1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pic1.MouseMove

If e.Button = Windows.Forms.MouseButtons.Left Then
            sender.Location = Point.op_Subtraction(Me.PointToClient(Cursor.Position), mousePoint)
            If Not dragBox.Contains(e.X, e.Y) Then
                Dim DropResult As DragDropEffects = pic1.DoDragDrop(pic1, DragDropEffects.Move)
                dragBox = Rectangle.Empty
            End If
        End If
    End Sub

Private Sub pic1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pic1.MouseUp
        dragBox = Rectangle.Empty
        mousePoint = Point.Empty
    End Sub

Private Sub lbl1_DragEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles lbl1.DragEnter
        sender.BackColor = Color.Red
    End Sub

Private Sub lbl1_DragLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lbl1.DragLeave
        sender.BackColor = Color.White
    End Sub

Private Sub lbl1_DragOver(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles lbl1.DragOver
        If e.AllowedEffect = DragDropEffects.Move Then
            e.Effect = DragDropEffects.Move
        End If
    End Sub

Private Sub pic1_GiveFeedback(ByVal sender As System.Object, ByVal e As System.Windows.Forms.GiveFeedbackEventArgs) Handles pic1.GiveFeedback
        If e.Effect = DragDropEffects.Move Then
            sender.Location = Point.op_Subtraction(Me.PointToClient(Cursor.Position), mousePoint)
        End If
    End Sub

←解決時は質問者本人がここをチェックしてください。

戻る