VB.NET|无边框窗体,拖动改变大小

原文地址:
http://www.tiancao.net/blogview.asp?logID=2183&cateID=4

'API定义部分 → Form1_load事件上面 →Form1 Class事件内
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
                                              ByVal hwnd As IntPtr, _
                                              ByVal wMsg As Integer, _
                                              ByVal wParam As Integer, _
                                              ByVal lParam As Integer) _
                                              As Boolean
Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" () As Boolean
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF010&
Const HTCAPTION = 2
Dim isMouseDown As Boolean = False
Dim direction As MouseDirection = MouseDirection.None
Dim mouseOff As Point
Public Enum MouseDirection
    Herizontal 
    Vertical
    Declining
    None
End Enum

Form1_MouseDown事件

Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
        mouseOff = New Point(-e.X, -e.Y)
        If e.Location.X >= Me.Width - 5 AndAlso e.Location.Y > Me.Height - 5 Then
            isMouseDown = True
        ElseIf e.Location.X >= Me.Width - 5 Then
            isMouseDown = True
        ElseIf e.Location.Y >= Me.Height - 5 Then
            isMouseDown = True
        Else
            Me.Cursor = Cursors.Arrow
            '改变鼠标样式为原样
            isMouseDown = False
            '鼠标移动事件
            ReleaseCapture()
            SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
        End If
End Sub

Form1_MouseMove事件

Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
        'ReleaseCapture()
        'SendMessage(Me.Handle, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
        '鼠标移动到边缘,改变鼠标的图标
        If e.Location.X >= Me.Width - 5 AndAlso e.Location.Y > Me.Height - 5 Then
            Me.Cursor = Cursors.SizeNWSE
            direction = MouseDirection.Declining
        ElseIf e.Location.X >= Me.Width - 5 Then
            Me.Cursor = Cursors.SizeWE
            direction = MouseDirection.Herizontal
        ElseIf e.Location.Y >= Me.Height - 5 Then
            Me.Cursor = Cursors.SizeNS
            direction = MouseDirection.Vertical
        Else
            '否则,以外的窗体区域,鼠标星座均为单向箭头(默认)             
            Me.Cursor = Cursors.Arrow
        End If
        If e.Location.X >= (Me.Width + Me.Left + 10) OrElse (e.Location.Y > Me.Height + Me.Top + 10) Then
            isMouseDown = False
        End If

        '设定好方向后,调用下面方法,改变窗体大小  
        ResizeWindow()
        
End Sub

自定义ResizeWindow()函数

Private Sub ResizeWindow()

        If Not isMouseDown Then
            Return
        End If
        If direction = MouseDirection.Declining Then
            'Me.Cursor = Cursors.SizeNWSE
            '改变宽度
            Me.Width = MousePosition.X - Me.Left + 5
            Me.Height = MousePosition.Y - Me.Top + 5
        ElseIf direction = MouseDirection.Herizontal Then
            'Me.Cursor = Cursors.SizeWE
            '改变宽度
            Me.Width = MousePosition.X - Me.Left + 5
        ElseIf direction = MouseDirection.Vertical Then
            'Me.Cursor = Cursors.SizeNS
            '改变高度
            Me.Height = MousePosition.Y - Me.Top + 5
        Else
            '鼠标不在窗口右和下边缘,把鼠标打回原型
            Me.Cursor = Cursors.Arrow
            isMouseDown = False
        End If
End Sub

Form1_MouseUp事件

Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
        Console.WriteLine("松开鼠标")
        isMouseDown = False
        direction = MouseDirection.None
        If isMouseDown Then
            isMouseDown = False
        End If
End Sub

你可能感兴趣的:(博客,vb.net)