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
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值