网创优客建站品牌官网
为成都网站建设公司企业提供高品质网站建设
热线:028-86922220
成都专业网站建设公司

定制建站费用3500元

符合中小企业对网站设计、功能常规化式的企业展示型网站建设

成都品牌网站建设

品牌网站建设费用6000元

本套餐主要针对企业品牌型网站、中高端设计、前端互动体验...

成都商城网站建设

商城网站建设费用8000元

商城网站建设因基本功能的需求不同费用上面也有很大的差别...

成都微信网站建设

手机微信网站建站3000元

手机微信网站开发、微信官网、微信商城网站...

建站知识

当前位置:首页 > 建站知识

vb点虐 拖动窗口 vb窗体移动到右上角

VB.NET鼠标拖动无边框窗体改变窗体大小

在VB中,BorderStyle属性为0的窗体没有边框,并且也没有与边框相关的元素。这种窗体具有简洁、占用空间少等优点,用它可以设计出某些富有个性的窗体。但是,由于它没有标题栏,窗体不能移动,同时也不能改变大小,在某些情况下会给使用者造成一定的麻烦。本文介绍在VB中如何用API函数操作无边框窗体。

十余年的通道网站建设经验,针对设计、前端、开发、售后、文案、推广等六对一服务,响应快,48小时及时工作处理。营销型网站的优势是能够根据用户设备显示端的尺寸不同,自动调整通道建站的显示方式,使网站能够适用不同显示终端,在浏览器中调整网站的宽度,无论在任何一种浏览器上浏览网站,都能展现优雅布局与设计,从而大程度地提升浏览体验。创新互联从事“通道网站设计”,“通道网站推广”以来,每个客户项目都认真落实执行。

移动窗体

新建一标准工程,设置Form1的BorderStyle属性为0。此时运行程序后,无法移动窗体。为能移动窗体,在Form1的代码窗口声明下列函数和常数:

Option Explicit

Private Declare Function ReleaseCapture Lib “user32” ()AsLong

Private Declare Function SendMessage Lib “user32”Alias“SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long,

ByVal wParam As Long, lParam As Any) As Long

Const WM_SYSCOMMAND = H112

Const SC_MOVE = HF012

在Form_MouseDown事件中输入以下代码:

Private Sub Form_MouseDown(Button As Integer, Shift As Integer,XAs Single, Y As Single)

按下鼠标左键

If Button = vbcenterButton Then

为当前的应用程序释放鼠标捕获

ReleaseCapture

移动窗体

SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0

End If

End Sub

注意:此时窗体上不能放置除Shape控件以外的任何控件,否则,在被控件遮住的地方点按鼠标还是无法移动窗体。要使点按控件也能移动窗体,需再添加一个该控件的MouseDown事件过程,代码与上述过程代码相似。

改变窗体的大小

为了改变窗体的大小,需要添加一个Timer控件,以定时捕获鼠标在窗体中的位置。当鼠标位于窗体边缘时,改变鼠标的形状,以通知用户可以进行改变大小的操作。为此,将Timer控件的Interval属性设为100(即每过100毫秒检测一下鼠标位置),其他取默认值。

在Form1的代码窗口中再添加下列两个函数,并定义两个自定义变量和一个字符串变量:

取得窗体位置的函数

Private Declare Function GetWindowRect Lib “user32” (ByVal hwndAsLong, lpRect As RECT) As Long

取得鼠标位置的函数

Private Declare Function GetCursorPos Lib “user32” (lpPointAsPOINTAPI) As Long

鼠标位置变量

Private Type POINTAPI

x As Long

y As Long

End Type

窗体位置变量

Private Type RECT

center As Long

Top As Long

center As Long

Bottom As Long

End Type

所要执行的动作变量,是移动还是改变大小及从哪个方向改变大小

Dim Action As String

在Timer1控件的Timer事件过程中添加以下代码:

Private Sub Timer1_Timer()

Dim MyRect As RECT

Dim MyPoint As POINTAPI

MyRect返回当前窗口位置

Call GetWindowRect(Me.hwnd, MyRect)

MyPoint返回当前鼠标位置

Call GetCursorPos(MyPoint)

Select Case True

鼠标位于窗体左上方

Case MyPoint.x MyRect.center + 5 And MyPoint.y ="" p=""

Screen.MousePointer = vbSizeNWSE

Action = “centerUp”

鼠标位于窗体右下方

Case MyPoint.x MyRect.center - 5 And MyPoint.yMyRect.Bottom - 5

Screen.MousePointer = vbSizeNWSE

Action = “centerDown”

鼠标位于窗体右上方

Case MyPoint.x MyRect.center - 5 And MyPoint.y="" p="" +=""

’45度双向鼠标指针

Screen.MousePointer = vbSizeNESW

Action = “centerUp”

鼠标位于窗体左下方

Case MyPoint.x MyRect.center + 5 And MyPoint.yMyRect.Bottom - 5

Screen.MousePointer = vbSizeNESW

Action = “centerDown”

鼠标位于窗体左边

Case MyPoint.x MyRect.center + 5

水平双向鼠标指针

Screen.MousePointer = vbSizeWE

Action = “center”

鼠标位于窗体右边热门推荐: C++程序设计之四书五经 谈谈JAVA程序的反编译1 2

MyRect.center - 5

Screen.MousePointer = vbSizeWE

Action = “center”

鼠标位于窗体上方

Case MyPoint.y MyRect.Top + 5

垂直双向鼠标指针

Screen.MousePointer = vbSizeNS

Action = “Up”

鼠标位于窗体下方

Case MyPoint.y MyRect.Bottom - 5

Screen.MousePointer = vbSizeNS

Action = “Down”

鼠标位于窗体其他位置

Case Else

默认鼠标指针

Screen.MousePointer = 0

Action = “Move”

End Select

End Sub

当利用SendMessage函数由系统向窗口发送改变大小的信息时,只要将上面移动窗体的语句“SendMessageMe.hwnd,WM_SYSCOMMAND, SC_MOVE, 0”中的第3个参数改为相应的常数即可。

VB中HF001~HF008分别是从左、右、上、左上、右上、下、左下、右下8个方向改变窗体大小的常数。结合移动窗体的代码,将上述Form_MouseDown事件的代码综合如下(也可以把这8个常数声明为自定义常数):

Private Sub Form_MouseDown(Button As Integer, Shift As Integer,xAs Single, y As Single)

按下鼠标左键

If Button = vbcenterButton Then

为当前的应用程序释放鼠标捕获

ReleaseCapture

Select Case Action

Case “center”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF001, 0

Case “center”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF002, 0

Case “Up”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF003, 0

Case “centerUp”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF004, 0

Case “centerUp”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF005, 0

Case “Down”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF006, 0

Case “centerDown”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF007, 0

Case “centerDown”

SendMessage Me.hwnd, WM_SYSCOMMAND, HF008, 0

Case “Move”

SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0

End Select

End If

End Sub

VB.NET怎么可以限制窗体不能被鼠标随便拖动位置

很简单,通过WindowsAPI,删除窗体菜单项就行了

首先在窗体类中声明API:

Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As IntPtr, ByVal bRevert As Boolean) As IntPtr

Declare Function RemoveMenu Lib "user32" (ByVal lngHmenu As IntPtr, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer

其次声明API参数常量:

Const MF_BYPOSITION As Integer = H400

然后在窗体类中写入过程:

Private Sub UserForm_Initialize_stopmove() '禁止窗体移动

  Dim lngHwnd As IntPtr

  Dim lngHmenu As IntPtr

  lngHwnd = Me.Handle

  If lngHwnd 0 Then

      lngHmenu = GetSystemMenu(lngHwnd, False)

      RemoveMenu(lngHmenu, 0, MF_BYPOSITION) '这里的0代表菜单中从上往下数第一个菜单项

  End If

End Sub

Private Sub UserForm_Initialize_onmove() '恢复窗体移动

  Dim lngHwnd As IntPtr

  Dim lngHmenu As IntPtr

  lngHwnd = Me.Handle

  If lngHwnd 0 Then

      lngHmenu = GetSystemMenu(lngHwnd, True)

RemoveMenu(lngHmenu, 0, MF_BYPOSITION) '这里的0与禁止代码中的数值同步,原因时虽然表面上删除了菜单项,实则为隐藏了菜单项,各个菜单的索引值并没有变,所以0依然代表初始菜单的第一个菜单项,即被删除的那个菜单项

  End If

End Sub

然后如果你的窗口菜单是动态变化的,建议声明常数:

Const MF_BYPOSITION As Integer = H0

然后使用相关的Windows功能的常数进行删除菜单。常数需要自行查看winuser.h头文件

如果找不到该头文件,可以看这里:网页链接

其余信息详见MSDN:网页链接

最后说一下,不建议前面网友说的重写WndProc的方法,因为这样拦截标题栏点击消息会导致窗体本身的菜单也无法显示出来,有损窗体功能,并且像双击左上角图标关闭窗体这样的功能也会跟着拦截消息的操作一起被吞掉。

VB.NET如何实现无边框窗体拖动? 如果能指定控件拖动更好 希望能有一点分析 使用VS2015

VB6.0写的,代码很简单,无意中写成的。应该可以参考。不需要任何api函数。在无边框窗体顶部中放入一个label标签。然后用label的 mouse down 和mouse move事件实现

Dim a, b As Single

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

a = X

b = Y

End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 Then

Form1.Move Left + X - a, Top + Y - b

End If

End Sub

VB.NET 拖动无边框窗体编程实例

Imports System Drawing Imports System Windows Forms ****************************************** Private oOriginalRegion As Region = Nothing 用于窗体移动 Private bFormDragging As Boolean = False Private oPointClicked As Point ****************************************** Private Sub Form _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 Form _MouseUp(ByVal sender As Object ByVal e As System Windows Forms MouseEventArgs) Handles MyBase MouseUp Me bFormDragging = False End Sub ****************************************** Private Sub Form _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 * _ (Me oPointClicked Y + _ SystemInformation CaptionHeight + _ SystemInformation BorderSize Height) * ) 移动窗体 Me Location = oMoveToPoint End If

lishixinzhi/Article/program/ASP/201311/21755


名称栏目:vb点虐 拖动窗口 vb窗体移动到右上角
网页链接:http://bjjierui.cn/article/ddisphc.html

其他资讯