VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 5434|回复: 6

[转帖] 操作VB中的无边框窗体(移动,调整大小)

[复制链接]
 楼主| 发表于 2009-6-11 15:26:51 | 显示全部楼层 |阅读模式
在网上搜到2篇关于这个问题的文章,发现各人的处理方法真是不一样,孰优孰劣,自己看吧。欢迎大家激烈讨论。


#3的要注意一点,form的ScaleMode是默认的1.如果要设为3,那么里面的100和200都需要更改

[ 本帖最后由 jay36 于 2009-6-11 15:30 编辑 ]
 楼主| 发表于 2009-6-11 15:27:10 | 显示全部楼层
在VB中,BorderStyle属性为0的窗体没有边框,并且也没有与边框相关的元素。这种窗体具有简洁、占用空间少等优点,用它可以设计出某些富有个性的窗体。但是,由于它没有标题栏,窗体不能移动,同时也不能改变大小,在某些情况下会给使用者造成一定的麻烦。本文介绍在VB中如何用API函数操作无边框窗体。
移动窗体

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

Private Declare Function ReleaseCapture Lib “user32” () As Long
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, X As Single, Y As Single)

'按下鼠标左键
If Button = vbLeftButton 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 hwnd As Long, lpRect As RECT) As Long

'取得鼠标位置的函数
Private Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long

'鼠标位置变量
Private Type POINTAPI

x As Long
y As Long

End Type
'窗体位置变量

Private Type RECT
Left As Long

Top As Long
Right 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.Left + 5 And MyPoint.y < MyRect.Top + 5
Screen.MousePointer = vbSizeNWSE

Action = “LeftUp”
'鼠标位于窗体右下方

Case MyPoint.x > MyRect.Right - 5 And MyPoint.y > MyRect.Bottom - 5
Screen.MousePointer = vbSizeNWSE

Action = “RightDown”
'鼠标位于窗体右上方

Case MyPoint.x > MyRect.Right - 5 And MyPoint.y < MyRect.Top + 5
'45度双向鼠标指针

Screen.MousePointer = vbSizeNESW
Action = “RightUp”

'鼠标位于窗体左下方
Case MyPoint.x < MyRect.Left + 5 And MyPoint.y > MyRect.Bottom - 5

Screen.MousePointer = vbSizeNESW
Action = “LeftDown”

'鼠标位于窗体左边
Case MyPoint.x < MyRect.Left + 5

'水平双向鼠标指针
Screen.MousePointer = vbSizeWE

Action = “Left”
'鼠标位于窗体右边

Case MyPoint.x > MyRect.Right - 5
Screen.MousePointer = vbSizeWE

Action = “Right”
'鼠标位于窗体上方

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函数由系统向窗口发送改变大小的信息时,只要将上面移动窗体的语句“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 Action
Case “Left”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF001, 0
Case “Right”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF002, 0
Case “Up”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF003, 0
Case “LeftUp”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF004, 0
Case “RightUp”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF005, 0
Case “Down”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF006, 0
Case “LeftDown”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF007, 0
Case “RightDown”

SendMessage Me.hwnd, WM_SYSCOMMAND, &HF008, 0
Case “Move”

SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
End Select

End If
End Sub
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-6-11 15:27:33 | 显示全部楼层
移动无边框窗口和改变无边框窗口大小
'---------------------------------------------------
Option Explicit
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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTBOTTOM = 15
Private Const HTTOP = 12
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14
Private Const HTBOTTOMLEFT = 16
Private Const HTBOTTOMRIGHT = 17

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Form_DblClick()
Unload Me
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim p As POINTAPI
p.X = X
p.Y = Y
Select Case True
    Case (p.X < 100 And p.Y < 200) Or (p.Y < 100 And p.X < 200)
        Screen.MousePointer = vbSizeNWSE
    Case (p.X > Me.ScaleWidth - 100 And p.Y > Me.ScaleHeight - 200) Or (p.Y > Me.ScaleHeight - 100 And p.X > Me.ScaleWidth - 200)
        Screen.MousePointer = vbSizeNWSE
    Case (p.X < 100 And p.Y > Me.ScaleHeight - 200) Or (p.Y > Me.ScaleHeight - 100 And p.X < 200)
        Screen.MousePointer = vbSizeNESW
    Case (p.X > Me.ScaleWidth - 100 And p.Y < 200) Or (p.Y < 100 And p.X > Me.ScaleWidth - 200)
        Screen.MousePointer = vbSizeNESW
    Case (p.X < 100 Or p.X > Me.ScaleWidth - 100)
        Screen.MousePointer = vbSizeWE
    Case (p.Y < 100 Or p.Y > Me.ScaleHeight - 100)
        Screen.MousePointer = vbSizeNS
    Case Else
        Screen.MousePointer = 0
End Select
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Dim p As POINTAPI
p.X = X: p.Y = Y
Call ReleaseCapture
Select Case True
    Case (p.X < 100 And p.Y < 200) Or (p.Y < 100 And p.X < 200)
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOPLEFT, 0
    Case (p.X > Me.ScaleWidth - 100 And p.Y > Me.ScaleHeight - 200) Or (p.Y > Me.ScaleHeight - 100 And p.X > Me.ScaleWidth - 200)
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0
    Case (p.X < 100 And p.Y > Me.ScaleHeight - 200) Or (p.Y > Me.ScaleHeight - 100 And p.X < 200)
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOMLEFT, 0
    Case (p.X > Me.ScaleWidth - 100 And p.Y < 200) Or (p.Y < 100 And p.X > Me.ScaleWidth - 200)
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOPRIGHT, 0
    Case p.X < 100
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTLEFT, 0
    Case p.X > Me.ScaleWidth - 100
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTRIGHT, 0
    Case p.Y < 100
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTTOP, 0
    Case p.Y > Me.ScaleHeight - 100
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTBOTTOM, 0
    Case Else
        SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Select
End Sub
回复 支持 反对

使用道具 举报

发表于 2009-6-11 22:29:46 | 显示全部楼层
强 强 强贴
问:
后台改变大小又如何?只能用事件.
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-6-12 16:26:19 | 显示全部楼层

回复 #4 jinshi517 的帖子

后台?直接width= height=,或者move
回复 支持 反对

使用道具 举报

发表于 2009-6-12 22:00:05 | 显示全部楼层
有时候,有必要的根据需要用事件去改变窗体大小
如果MoveWindow,窗体收不到某些消息
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-6-19 09:07:50 | 显示全部楼层

回复 #6 jinshi517 的帖子

MoveWindow之类 跟本贴不是同一个问题啊。这里所指的是用户控制。
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-3 00:41

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表