窗体控件大小随窗体大小变化而变化

在Form的Resize事件中调用函数Resize_All就能实现控件自动调整大小，如：

Private Sub Form_Resize()
Dim H, i As Integer
On Error Resume Next
Resize_ALL Me 'Me是窗体名，Form1,Form2等等都可以

End Sub

在模块中添加以下代码：

Public Type ctrObj
Name As String
Index As Long
Parrent As String
Top As Long
Left As Long
Height As Long
Width As Long
ScaleHeight As Long
ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function ReleaseCapture Lib "USER32" () As Long
Function ActualPos(plLeft As Long) As Long

If plLeft < 0 Then
ActualPos = plLeft + 75000
Else
ActualPos = plLeft
End If

End Function

Function FindForm(pfrmIn As Form) As Long

Dim i As Long
FindForm = -1

If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then
FindForm = i
Exit Function
End If

Next i

End If

End Function

Function AddForm(pfrmIn As Form) As Long

Dim FormControl As Control
Dim i As Long
ReDim Preserve FormRecord(MaxForm + 1)

FormRecord(MaxForm).Name = pfrmIn.Name

FormRecord(MaxForm).Top = pfrmIn.Top

FormRecord(MaxForm).Left = pfrmIn.Left

FormRecord(MaxForm).Height = pfrmIn.Height

FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight

FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
AddForm = MaxForm
MaxForm = MaxForm + 1

For Each FormControl In pfrmIn
i = FindControl(FormControl, pfrmIn.Name)

If i < 0 Then
i = AddControl(FormControl, pfrmIn.Name)
End If

Next FormControl

End Function

Function FindControl(inControl As Control, inName As String) As Long

Dim i As Long
FindControl = -1

For i = 0 To (MaxControl - 1)

If ControlRecord(i).Parrent = inName Then
If ControlRecord(i).Name = inControl.Name Then
On Error Resume Next

If ControlRecord(i).Index = inControl.Index Then
FindControl = i
Exit Function
End If

On Error GoTo 0
End If

End If

Next i

End Function

Function AddControl(inControl As Control, inName As String) As Long

ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).Name = inControl.Name
ControlRecord(MaxControl).Index = inControl.Index
ControlRecord(MaxControl).Parrent = inName

If TypeOf inControl Is Line Then
ControlRecord(MaxControl).Top = inControl.Y1
ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
ControlRecord(MaxControl).Height = inControl.Y2
ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
Else
ControlRecord(MaxControl).Top = inControl.Top
ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
ControlRecord(MaxControl).Height = inControl.Height
ControlRecord(MaxControl).Width = inControl.Width
End If

inControl.IntegralHeight = False
On Error GoTo 0
AddControl = MaxControl
MaxControl = MaxControl + 1
End Function

Function PerWidth(pfrmIn As Form) As Long

Dim i As Long
i = FindForm(pfrmIn)

If i < 0 Then
i = AddForm(pfrmIn)
End If

PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function

Function PerHeight(pfrmIn As Form) As Double

Dim i As Long
i = FindForm(pfrmIn)

If i < 0 Then
i = AddForm(pfrmIn)
End If

PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function

Public Sub ResizeControl(inControl As Control, pfrmIn As Form)

On Error Resume Next
Dim i As Long
Dim widthfactor As Single, heightfactor As Single
Dim minFactor As Single
Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
yRatio = PerHeight(pfrmIn)
xRatio = PerWidth(pfrmIn)
i = FindControl(inControl, pfrmIn.Name)

If inControl.Left < 0 Then
lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If

lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)
If TypeOf inControl Is Line Then

If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
Else
inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
End If

inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)

If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
Else
inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
End If

inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
Else
inControl.Move lLeft, lTop, lWidth, lHeight
inControl.Move lLeft, lTop, lWidth
inControl.Move lLeft, lTop
End If

End Sub

Public Sub ResizeForm(pfrmIn As Form)

Dim FormControl As Control
Dim isVisible As Boolean
Dim StartX, StartY, MaxX, MaxY As Long
Dim bNew As Boolean

If Not bRunning Then
bRunning = True

If FindForm(pfrmIn) < 0 Then
bNew = True
Else
bNew = False
End If

If pfrmIn.Top < 30000 Then
isVisible = pfrmIn.Visible
On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
' ' pfrmIn.Visible = False
Else

If bNew Then
StartY = pfrmIn.Height
StartX = pfrmIn.Width
On Error Resume Next

For Each FormControl In pfrmIn

If FormControl.Left + FormControl.Width + 200 > MaxX Then
MaxX = FormControl.Left + FormControl.Width + 200
End If

If FormControl.Top + FormControl.Height + 500 > MaxY Then
MaxY = FormControl.Top + FormControl.Height + 500
End If

If FormControl.X1 + 200 > MaxX Then
MaxX = FormControl.X1 + 200
End If

If FormControl.Y1 + 500 > MaxY Then
MaxY = FormControl.Y1 + 500
End If

If FormControl.X2 + 200 > MaxX Then
MaxX = FormControl.X2 + 200
End If

If FormControl.Y2 + 500 > MaxY Then
MaxY = FormControl.Y2 + 500
End If

Next FormControl

On Error GoTo 0
pfrmIn.Height = MaxY
pfrmIn.Width = MaxX
End If

On Error GoTo 0
End If

For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl

On Error Resume Next

If Not pfrmIn.MDIChild Then
On Error GoTo 0
pfrmIn.Visible = isVisible
Else

If bNew Then
pfrmIn.Height = StartY
pfrmIn.Width = StartX

For Each FormControl In pfrmIn
ResizeControl FormControl, pfrmIn
Next FormControl

End If

End If

On Error GoTo 0
End If

bRunning = False
End If

End Sub

Public Sub SaveFormPosition(pfrmIn As Form)

Dim i As Long

If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then

FormRecord(i).Top = pfrmIn.Top

FormRecord(i).Left = pfrmIn.Left

FormRecord(i).Height = pfrmIn.Height

FormRecord(i).Width = pfrmIn.Width
Exit Sub
End If

Next i

AddForm (pfrmIn)
End If

End Sub

Public Sub RestoreFormPosition(pfrmIn As Form)

Dim i As Long
If MaxForm > 0 Then

For i = 0 To (MaxForm - 1)

If FormRecord(i).Name = pfrmIn.Name Then

If FormRecord(i).Top < 0 Then
pfrmIn.WindowState = 2
ElseIf FormRecord(i).Top < 30000 Then
pfrmIn.WindowState = 0
pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
Else
pfrmIn.WindowState = 1
End If

Exit Sub
End If

Next i

End If

End Sub
Public Sub Resize_ALL(Form_Name As Form)

Dim OBJ As Object
For Each OBJ In Form_Name
ResizeControl OBJ, Form_Name
Next OBJ

End Sub

Public Sub DragForm(frm As Form)

On Local Error Resume Next
Call ReleaseCapture
Call SendMessage(frm.hwnd, WM_NCLBUTTONDOWN, 2, 0)

End Sub