<pre name="code" class="vb">'较好用,没有闪动
Declare Auto Function ReleaseCapture Lib "user32.dll" Alias "ReleaseCapture" () As Boolean
'API ReleaseCapture函数是用来释放鼠标捕获的
Declare Auto Function SendMessage Lib "user32.dll" Alias "SendMessage" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
'向windows发送消息
Public Const WM_SYSCOMMAND As Integer = &H112&
Public Const SC_MOVE As Integer = &HF010&
Public Const HTCAPTION As Integer = &H2&
Private Sub frm1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
If e.Button = MouseButtons.Left Then
ReleaseCapture()
SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
End If
End Sub
'这种方法会造成鼠标点一下窗体瞬间移动到某处,有闪动现象
Private mouseOffset As Point
'记录鼠标指针的坐标
Private isMouseDown As Boolean
Private Sub frm1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
Dim xOffset As Integer
Dim yOffset As Integer
If (e.Button = MouseButtons.Left) Then
xOffset = -e.X - SystemInformation.FrameBorderSize.Width
yOffset = -e.Y - SystemInformation.CaptionHeight - SystemInformation.FrameBorderSize.Height
mouseOffset = New Point(xOffset, yOffset)
isMouseDown = True
End If
End Sub
Private Sub frm1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
If (isMouseDown) Then
Dim mousePos As Point = Control.MousePosition
mousePos.Offset(mouseOffset.X, mouseOffset.Y)
Location = mousePos
End If
End Sub
Private Sub frm1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
If (e.Button = MouseButtons.Left) Then
isMouseDown = False
End If
End Sub
vb.net 实现无标题栏窗体拖拽功能
最新推荐文章于 2021-10-30 18:46:28 发布