Question

如何改变无边框窗口大小

请问在VB中如何改变无边框窗口的大小？

Answer 1

添加一个按钮退出 label显示坐标
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 Command1_Click()
End
End Sub

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 2

'就是一个问题，如果别人拉到0的话呢？ 窗口不见了？！所以可能一下这个 可能还好一点！

'请先加一个 Label1 控件！这个不会缩小到窗口不见！最小也会留一点点！

'==============================================================

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 3

在事件里添加 Form1.Height = 3000
Form1.Width = 3000