vb.net: 一个用户控件，把它放在窗体中，当拖动它时，窗体也随之移动，这样这个窗体就不需要标题栏来拖动了

Posted 2021-03-08 gaoleionline

     首先新建一个用户控件，这个控件中只有一个 label ，其名为： lblDrag，至于其所显示的文本和大小，可以随意设置。

     接下来打开其代码界面，输入以下代码：

-------------------------------------------------------------------------------------------------
‘ 用户控件，当拖动这个控件时，该控件所属的窗体会被拖动
Public Class uc_dagrLabelToMove

Private isDragging As Boolean = False ‘ 当前是否在拖动过程中
Private originalLocation As Point ‘ 初始的位置
Private moveToPoint As Point ‘ 拖动的位置

Private frm As Form ‘ 本控件所属的窗体

‘ 根据一个控件获取其所属的窗体
Private Function GetCurrentCtrlTopForm(currentCtrl As Control) As Object

If IsNothing(currentCtrl) Then
Return Nothing
End If

Dim pCtrl As Control = currentCtrl.Parent ‘ 上一级控件

While (True) ‘ 一级一级找上去，直到找到所属的窗体为止

If TypeOf pCtrl Is Form Then
Exit While
Else
pCtrl = pCtrl.Parent
If TypeOf pCtrl Is Form Then
Exit While
End If
End If

End While

Return pCtrl ‘ 返回该窗体

End Function

‘ 当鼠标点下去时
Private Sub Label1_MouseDown(sender As Object, e As MouseEventArgs) Handles lblDrag.MouseDown

frm = GetCurrentCtrlTopForm(Me) ‘ 获取所属的窗体
‘MessageBox.Show(frm.Left & " , " & frm.Top & " , " & frm.Width & " , " & frm.Height)

isDragging = True ‘ 当前是在拖动过程中了

originalLocation = New Point(e.X, e.Y) ‘ 获取当时鼠标按下后在窗体上的位置坐标

End Sub

‘ 当鼠标抬起来时
Private Sub lbldrag_MouseUp(sender As Object, e As MouseEventArgs) Handles lblDrag.MouseUp
isDragging = False ‘ 拖动过程结束
End Sub

‘ 当鼠标在本控件上移动时
Private Sub lbldrag_MouseMove(sender As Object, e As MouseEventArgs) Handles lblDrag.MouseMove

If isDragging Then ‘ 如果是在拖动过程中

‘‘方法一：
moveToPoint = New Point(e.X, e.Y) ‘鼠标移动后在窗体上的坐标
frm.Location = frm.PointToScreen(moveToPoint) - originalLocation

‘方法二：
‘ moveToPoint = frm.PointToScreen(New Point(e.X, e.Y)) ‘获取鼠标相对于屏幕的位置坐标
‘moveToPoint.Offset(originalLocation.X * -1, originalLocation.Y * -1)
‘frm.Location = moveToPoint

End If

 

End Sub

‘ 当鼠标离开时
Private Sub lbldrag_MouseLeave(sender As Object, e As EventArgs) Handles lblDrag.MouseLeave
isDragging = False ‘ 拖动过程结束
End Sub

End Class