田草博客
日志搜索


 标题   内容 评论


网友交流QQ群:11740834 需注明申请加入原因

微信 公众号:ByCAD

邮箱:tiancao1001x126.com
ByCAD,微信公众号
首页 | 普通 | 电脑 | AutoCAD | VB/VB.NET | FLash | 结构 | 建筑 | 电影 | BIM | 规范 | 软件
-电信用户-|-网通用户-
-博客论坛-|-软件下载-
-网站导航-|-规范下载-
-BelovedFLash欣赏-

用户登陆
用户:
密码:
 

站点日历
73 2020 - 2 48
      1
2345678
9101112131415
16171819202122
23242526272829


站点统计

最新评论



VB.net Listbox 每行字体设置不同字体 Vb.net设置splitcontainer分界线
未知 VB.net移动无边框窗体和改变无边框窗体大小   [ 日期:2019-12-17 ]   [ 来自:本站原创 ]  HTML
移动窗体和改变大小
程序代码:

Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System
Imports System.Windows.Forms
Public Class Form1
    Dim isMouseDown As Boolean = False
    '表示鼠标当前是否处于按下状态,初始值为否 
    Dim direction As MouseDirection = MouseDirection.None
    '表示拖动的方向,起始为None,表示不拖动
    Dim mouseOff As Point
    '定义一个枚举,表示拖动方向
    Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Declare Function ReleaseCapture Lib "user32" Alias "ReleaseCapture" () As Boolean
    Public Const WM_SYSCOMMAND = &H112
    Public Const SC_MOVE = &HF010
    Public Const HTCAPTION = &H2

    Public Enum MouseDirection
        Herizontal
        '水平方向拖动,只改变窗体的宽度  
        Vertical
        '垂直方向拖动,只改变窗体的高度  
        Declining
        '倾斜方向,同时改变窗体的宽度和高度
        None
    End Enum
   
    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As 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
    Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseUp
        Console.WriteLine("松开鼠标")
        isMouseDown = False
        direction = MouseDirection.None
        If isMouseDown Then
            isMouseDown = False
        End If
    End Sub
    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseMove
        '鼠标移动到边缘,改变鼠标的图标
        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
    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

End Class


'移动窗体
程序代码:

Public Class Form1
    '******************************************
    Private oOriginalRegion As Region = Nothing
    ' 用于窗体移动
    Private bFormDragging As Boolean = False
    Private oPointClicked As Point

    '******************************************

    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown

        Me.bFormDragging = True
        Me.oPointClicked = New Point(e.X, e.Y)

    End Sub
    '******************************************

    Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
        Me.bFormDragging = False

    End Sub
    '******************************************

    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
        If Me.bFormDragging Then
            Dim oMoveToPoint As Point
            ' 以当前鼠标位置为基础,找出目标位置
            oMoveToPoint = Me.PointToScreen(New Point(e.X, e.Y))
            ' 根据开始位置作出调整
            oMoveToPoint.Offset(Me.oPointClicked.X * -1, _
            (Me.oPointClicked.Y + _
            SystemInformation.CaptionHeight + _
            SystemInformation.BorderSize.Height) * -1)
            ' 移动窗体
            Me.Location = oMoveToPoint
        End If

    End Sub
End Class




[本日志由 tiancao1001 于 2019-12-17 08:48 PM 编辑]


暂时没有评论
发表评论 - 不要忘了输入验证码哦!
作者: 用户:  密码:   注册? 验证:  防止恶意留言请输入问题答案:1*2=?  
评论:

禁止表情
禁止UBB
禁止图片
识别链接
识别关键字

字体样式 文字大小 文字颜色
插入粗体文本 插入斜体文本 插入下划线
左对齐 居中对齐 右对齐
插入超级链接 插入邮件地址 插入图像
插入 Flash 插入代码 插入引用
插入列表 插入音频文件 插入视频文件
插入缩进符合
点击下载按钮 下标 上标
水平线 简介分割标记
表  情
 
Tiancao Blog All Rights Reserved 田草博客 版权所有
Copyright ©