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
沒有留言:
張貼留言