VB.Net使可拖动控件不移出窗体

Question

我有一个使用下面代码可拖动的自定义控件，但问题是我可以将控件移出表单。

    Private Sub ObjCan_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
    If e.Button = Windows.Forms.MouseButtons.Left Then
        Me.Location = New Point(FormGame.PointToClient(MousePosition).X - 16, FormGame.PointToClient(MousePosition).Y - 16)
    End If
End Sub

Answer 1

设置光标。剪辑以限制鼠标移动:

获取或设置表示裁剪矩形的边界游标。被剪切的光标只允许在其剪切范围内移动矩形。

下面是一个快速的Label示例。请注意，如果您将Label移动到不同的容器中，例如Panel，代码仍然可以工作，并且Label将被限制在Panel的边界内:

Public Class Form1
    Private PrevClip As Rectangle
    Private Sub Label1_MouseDown(sender As Object, e As MouseEventArgs) Handles Label1.MouseDown
        PrevClip = Cursor.Clip
        Dim ctl As Control = DirectCast(sender, Control)
        Dim ctlContainer As Control = ctl.Parent
        Cursor.Clip = ctlContainer.RectangleToScreen(New Rectangle(0, 0, ctlContainer.ClientSize.Width - ctl.Width, ctlContainer.ClientSize.Height - ctl.Height))
    End Sub
    Private Sub Label1_MouseMove(sender As Object, e As MouseEventArgs) Handles Label1.MouseMove
        If e.Button = MouseButtons.Left Then
            Dim ctl As Control = DirectCast(sender, Control)
            Dim ctlContainer As Control = ctl.Parent
            ctl.Location = ctlContainer.PointToClient(Cursor.Position)
        End If
    End Sub
    Private Sub Label1_MouseUp(sender As Object, e As MouseEventArgs) Handles Label1.MouseUp
        Cursor.Clip = PrevClip
    End Sub
End Class