2016年2月10日 星期三

Visual Basic 隱藏標題列後要如何 移動/拖曳視窗

針對Form1表單:
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

沒有留言:

張貼留言