操作VB中的无边框窗体
2008-02-23 06:56:58来源:互联网 阅读 ()
移动窗体
新建一标准工程,设置Form1的BorderStyle属性为0。此时运行程序后,无法移动窗体。为能移动窗体,在Form1的代码窗口声明下列函数和常数:Option Explicit
Private Declare Function ReleaseCapture Lib “user32” () As LongPrivate 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 = &H112Const SC_MOVE = &HF012
在Form_MouseDown事件中输入以下代码:Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'按下鼠标左键If Button = vbLeftButton Then
'为当前的应用程序释放鼠标捕获ReleaseCapture
'移动窗体SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End IfEnd Sub
注意:此时窗体上不能放置除Shape控件以外的任何控件,否则,在被控件遮住的地方点按鼠标还是无法移动窗体。要使点按控件也能移动窗体,需再添加一个该控件的MouseDown事件过程,代码与上述过程代码相似。改变窗体的大小
为了改变窗体的大小,需要添加一个Timer控件,以定时捕获鼠标在窗体中的位置。当鼠标位于窗体边缘时,改变鼠标的形状,以通知用户可以进行改变大小的操作。为此,将Timer控件的Interval属性设为100(即每过100毫秒检测一下鼠标位置),其他取默认值。在Form1的代码窗口中再添加下列两个函数,并定义两个自定义变量和一个字符串变量:
'取得窗体位置的函数Private Declare Function GetWindowRect Lib “user32” (ByVal hwnd As Long, lpRect As RECT) As Long
'取得鼠标位置的函数Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
'鼠标位置变量Private Type POINTAPI
x As Longy As Long
End Type'窗体位置变量
Private Type RECTLeft As Long
Top As LongRight As Long
Bottom As LongEnd Type
'所要执行的动作变量,是移动还是改变大小及从哪个方向改变大小Dim Action As String
在Timer1控件的Timer事件过程中添加以下代码:Private Sub Timer1_Timer()
Dim MyRect As RECTDim MyPoint As POINTAPI
' MyRect返回当前窗口位置Call GetWindowRect(Me.hwnd, MyRect)
' MyPoint返回当前鼠标位置Call GetCursorPos(MyPoint)
Select Case True'鼠标位于窗体左上方
Case MyPoint.x < MyRect.Left + 5 And MyPoint.y < MyRect.Top + 5Screen.MousePointer = vbSizeNWSE
Action = “LeftUp”'鼠标位于窗体右下方
Case MyPoint.x > MyRect.Right - 5 And MyPoint.y > MyRect.Bottom - 5Screen.MousePointer = vbSizeNWSE
Action = “RightDown”'鼠标位于窗体右上方
Case MyPoint.x > MyRect.Right - 5 And MyPoint.y < MyRect.Top + 5'45度双向鼠标指针
Screen.MousePointer = vbSizeNESWAction = “RightUp”
'鼠标位于窗体左下方Case MyPoint.x < MyRect.Left + 5 And MyPoint.y > MyRect.Bottom - 5
Screen.MousePointer = vbSizeNESWAction = “LeftDown”
'鼠标位于窗体左边Case MyPoint.x < MyRect.Left + 5
'水平双向鼠标指针Screen.MousePointer = vbSizeWE
Action = “Left”'鼠标位于窗体右边
Case MyPoint.x > MyRect.Right - 5Screen.MousePointer = vbSizeWE
Action = “Right”'鼠标位于窗体上方
Case MyPoint.y < MyRect.Top + 5'垂直双向鼠标指针
Screen.MousePointer = vbSizeNSAction = “Up”
'鼠标位于窗体下方Case MyPoint.y > MyRect.Bottom - 5
Screen.MousePointer = vbSizeNSAction = “Down”
'鼠标位于窗体其他位置Case Else
'默认鼠标指针Screen.MousePointer = 0
Action = “Move”End Select
End Sub当利用SendMessage函数由系统向窗口发送改变大小的信息时,只要将上面移动窗体的语句“SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0”中的第3个参数改为相应的常数即可。
VB中&HF001~&HF008分别是从左、右、上、左上、右上、下、左下、右下8个方向改变窗体大小的常数。结合移动窗体的代码,将上述Form_MouseDown事件的代码综合如下(也可以把这8个常数声明为自定义常数):Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'按下鼠标左键If Button = vbLeftButton Then
'为当前的应用程序释放鼠标捕获ReleaseCapture
Select Case ActionCase “Left”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF001, 0Case “Right”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF002, 0Case “Up”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF003, 0Case “LeftUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF004, 0Case “RightUp”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF005, 0Case “Down”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF006, 0Case “LeftDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF007, 0Case “RightDown”
SendMessage Me.hwnd, WM_SYSCOMMAND, &HF008, 0Case “Move”
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0End Select
End IfEnd Sub
上一篇: 制造出透明的窗体(Form)
下一篇: 透明的窗体(From)上显示背景透通图
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
上一篇:VB常见问题解答(1)
- 操作VB中的无边框窗体 2018-06-17
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash