Dim nClick, nOldWnd As Point
Dim isMouseDown As Boolean = False
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown
If e.Button = MouseButtons.Left Then
'紀錄滑鼠點選時的視窗位置與滑鼠點選位置
nOldWnd = New Point(Me.Left, Me.Top)
nClick = New Point(e.X, e.Y)
isMouseDown = True
End If
End Sub
Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove
If isMouseDown = True Then '如果滑鼠按著拖曳
'設定新的視窗位置
Me.Top = e.Y + nOldWnd.Y - nClick.Y
Me.Left = e.X + nOldWnd.X - nClick.X
'更新紀錄的視窗位置
nOldWnd.X = Me.Left
nOldWnd.Y = Me.Top
End If
End Sub
Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseUp
If e.Button = MouseButtons.Left Then
isMouseDown = False
End If
End Sub模組化副函式:
Dim nClick, nOldWnd As Point
Dim isMouseDown As Boolean = False
Private Sub Record(e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
'紀錄滑鼠點選時的視窗位置與滑鼠點選位置
nOldWnd = New Point(Me.Left, Me.Top)
nClick = New Point(e.X, e.Y)
isMouseDown = True
End If
End Sub
Private Sub WndMove(e As MouseEventArgs)
If isMouseDown = True Then '如果滑鼠按著拖曳
'設定新的視窗位置
Me.Top = e.Y + nOldWnd.Y - nClick.Y
Me.Left = e.X + nOldWnd.X - nClick.X
'更新紀錄的視窗位置
nOldWnd.X = Me.Left
nOldWnd.Y = Me.Top
End If
End Sub
Private Sub MoveEnd(e As MouseEventArgs)
If e.Button = MouseButtons.Left Then
isMouseDown = False
End If
End Sub模組化副函式呼叫示範:
Private Sub design_MouseDown(sender As Object, e As MouseEventArgs) Handles design.MouseDown
Record(e)
End Sub
Private Sub design_MouseMove(sender As Object, e As MouseEventArgs) Handles design.MouseMove
WndMove(e)
End Sub
Private Sub design_MouseUp(sender As Object, e As MouseEventArgs) Handles design.MouseUp
MoveEnd(e)
End Sub以上是很容易理解的方法,我這邊再提供幾個網路找到的方法,只針對Form1表單:(也有可能是我不會用,我目前還是看不懂原理)
一般拖曳功能:
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = 163 AndAlso Me.ClientRectangle.Contains(Me.PointToClient(New Point(m.LParam.ToInt32()))) AndAlso m.WParam.ToInt32() = 2 Then
m.WParam = 1
End If
MyBase.WndProc(m)
If m.Msg = 132 AndAlso m.Result.ToInt32() = 1 Then
m.Result = 2
End If
End Sub拖曳和 double click最大化:
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Const WM_NCHITTEST As Integer = &H84
Const HTCLIENT As Integer = &H1
Const HTCAPTION As Integer = &H2
MyBase.WndProc(m)
Select Case m.Msg
Case WM_NCHITTEST
If m.Result.ToInt32 = HTCLIENT Then
m.Result = New IntPtr(HTCAPTION)
End If
End Select
End Sub拖曳和 double click最大化、拖曳大小:
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Const WM_NCHITTEST As Integer = &H84
Const HTCLIENT As Integer = &H1
Const HTCAPTION As Integer = &H2
Const HTLEFT As Integer = 10
Const HTRIGHT As Integer = 11
Const HTTOP As Integer = 12
Const HTTOPLEFT As Integer = 13
Const HTTOPRIGHT As Integer = 14
Const HTBOTTOM As Integer = 15
Const HTBOTTOMLEFT As Integer = 16
Const HTBOTTOMRIGHT As Integer = 17
MyBase.WndProc(m)
Select Case m.Msg
Case WM_NCHITTEST
If m.Result.ToInt32 = HTCLIENT Then
m.Result = New IntPtr(HTCAPTION)
End If
Dim 目標寬度 As Integer = 5
Dim nPosX = CInt(m.LParam) Mod 65536 '---LoWord---
Dim nPosY = CInt(m.LParam) / 65536 '---HiWord---
Dim 上 As Boolean = (nPosY <= Top + 目標寬度)
Dim 右 As Boolean = (nPosX >= Left + Width - 目標寬度)
Dim 下 As Boolean = (nPosY >= Top + Height - 目標寬度)
Dim 左 As Boolean = (nPosX <= Left + 目標寬度)
Select Case True
Case 上 * 右 : m.Result = New IntPtr(HTTOPRIGHT)
Case 上 * 左 : m.Result = New IntPtr(HTTOPLEFT)
Case 下 * 右 : m.Result = New IntPtr(HTBOTTOMRIGHT)
Case 下 * 左 : m.Result = New IntPtr(HTBOTTOMLEFT)
Case 上 : m.Result = New IntPtr(HTTOP)
Case 右 : m.Result = New IntPtr(HTRIGHT)
Case 下 : m.Result = New IntPtr(HTBOTTOM)
Case 左 : m.Result = New IntPtr(HTLEFT)
End Select
End Select
End Sub
沒有留言:
張貼留言