Question

VB 无边框窗体如何改变大小

我想做一个无边框窗体，但又想通过某一按钮来改变窗体的大小。我从网上搜了一下，找到有人设计的两个程序，大家都说好。我试了一下，运行中也没发现什么错误，但我水平太低，就是不知道如何调用，朋友们指点一下。原程序全文如下：
'加一个标签控件，其他的也可以
'加一个标签控件，其他的也可以 '加一个标签控件，其他的也可以
Option Explicit
Private Sub Form_Load()
Label1.BackColor = vbBlack
Label1.Height = 200
Label1.Width = 200
Label1.Left = Me.Width - Label1.Width
Label1.Top = Me.Height - Label1.Height
End Sub

Private Sub Form_Resize()
Label1.Left = Me.Width - Label1.Width
Label1.Top = Me.Height - Label1.Height
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 0 Then
If Me.Width + X > 500 Then Me.Width = Me.Width + X
If Me.Height + Y > 500 Then Me.Height = Me.Height + Y
End If
End Sub

==============下面这个更好点~
第二个太大，写不下了，先看这一个吧。
我以前找到的两个程序，就是下面这位朋友所讲的，可是我不知道如何调用呀。谁能指点一下？谢谢。必要的话，可以用汉语文字说明。

Answer 1

很简单啊，窗口里放入一个Label1，再把上面的代码复制粘贴到代码窗口，运行即可。鼠标放到窗口右下角的黑色小块（也就是Label1），点住拖动即可任意改变窗体大小了。

追问

谢谢！我想请教另外一个问题，怎么能让控件随着窗体改变位置和大小，这个程序好像不行。

追答

可以的啊，你把改变控件大小和位置的代码放到Form_Resize事件中即可，比如：
在窗体上放入一个Text1
Private Sub Form_Resize()
Text1.Move Me.ScaleWidth \ 2, 0, Me.ScaleWidth \ 2, Me.ScaleHeight
End Sub
这样，不管窗体如何改变大小，Text1始终占据窗体右边一半的位置。
你那个程序也一样的，它可以让那个小黑块始终保持在窗体的右下角，这也是“让控件随着窗体改变位置”啊，只不过没有改变大小而已。

Answer 2

'加一个标签控件，其他的也可以
Option Explicit
Private Sub Form_Load()
Label1.BackColor = vbBlack
Label1.Height = 200
Label1.Width = 200
Label1.Left = Me.Width - Label1.Width
Label1.Top = Me.Height - Label1.Height
End Sub

Private Sub Form_Resize()
Label1.Left = Me.Width - Label1.Width
Label1.Top = Me.Height - Label1.Height
End Sub

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 0 Then
If Me.Width + X > 500 Then Me.Width = Me.Width + X
If Me.Height + Y > 500 Then Me.Height = Me.Height + Y
End If
End Sub

==============下面这个更好点~

Option Explicit
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTLEFT = 10
Private Const HTRIGHT = 11
Private Const HTTOP = 12
Private Const HTBOTTOM = 15
Private Const HTBOTTOMRIGHT = 17
Private Const HTBOTTOMLEFT = 16
Private Const HTTOPLEFT = 13
Private Const HTTOPRIGHT = 14

'sendmessage函数声明
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 Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long

Private intEdge As Integer '临界距离，鼠标在离边框距离小于等于该值则判定在边框上……

Private Sub Form_Load()
'相当于三个象素
intEdge = Me.ScaleX(3, vbPixels, Me.ScaleMode)
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Critical:将处理四角的代码放在前面
If X + intEdge >= ScaleWidth And Y + intEdge >= ScaleHeight Then '右下角
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOMRIGHT, 0
ElseIf Y + intEdge >= ScaleHeight And X <= intEdge Then '左下角
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOMLEFT, 0
ElseIf Y <= intEdge And X <= intEdge Then '左上角
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOPLEFT, 0
ElseIf Y <= intEdge And X + intEdge <= ScaleWidth Then '右上边
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOPRIGHT, 0
ElseIf X + intEdge >= ScaleWidth And Y <= ScaleHeight Then '右边
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTRIGHT, 0
ElseIf Y + intEdge >= ScaleHeight And X <= ScaleWidth Then '下边
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTBOTTOM, 0
ElseIf X <= intEdge And Y <= ScaleHeight Then '左边
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTLEFT, 0
ElseIf Y <= intEdge And X <= ScaleWidth Then '上边
ReleaseCapture
SendMessage hwnd, WM_NCLBUTTONDOWN, HTTOP, 0
End If
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Critical:将处理四角的代码放在前面
Label1.Caption = X & " " & Y
If (X + intEdge >= ScaleWidth And Y + intEdge >= ScaleHeight) Or (Y <= intEdge And X <= intEdge) Then '右下\左上角
MousePointer = vbSizeNWSE
ElseIf Y + intEdge >= ScaleHeight And X <= intEdge Or Y <= intEdge And X + intEdge <= ScaleWidth Then '左下\右上角
MousePointer = vbSizeNESW
ElseIf X + intEdge >= ScaleWidth And Y <= ScaleHeight Or X <= intEdge And Y <= ScaleHeight Then '左、右
MousePointer = vbSizeWE
ElseIf Y + intEdge >= ScaleHeight And X <= ScaleWidth Or Y <= intEdge And X <= ScaleWidth Then '上边下边
MousePointer = vbSizeNS
Else
MousePointer = vbNormal
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SetCapture hwnd
End Sub

Answer 3

你的下面两句
Label1.Left = Me.Width - Label1.Width
Label1.Top = Me.Height - Label1.Height

应该改成如下代码才能看到效果：
Label1.Left = Me.ScaleWidth - Label1.Width
Label1.Top = Me.ScaleHeight - Label1.Height

Answer 4

鼠标移到右下角拖动试试