Dim OldW  As Single
Dim OldH  As Single

'窗口大小发生改变时
Private Sub Form_Resize()
On Error Resume Next
'最小大小,防止比例失调
If Me.Width < 4800 Then Me.Width = 4800
If Me.Height < 3600 Then
Me.Height = 3600
Exit Sub
End If
Dim cu As Control
For Each cu In Me.Controls
'调整大小
cu.Move cu.Left * Me.Width / OldW, cu.Top * Me.Height / OldH, cu.Width * Me.Width / OldW, cu.Height * Me.Height / OldH
Next
'赋值
OldW = Me.Width
OldH = Me.Height
End Sub

Me.ScaleWidth
Me.ScaleHeight

'在调用ResizeForm前先调用本函数
Public Sub resizeinit(formname As Form)

    Dim obj As Control
   
    FormOldWidth = formname.ScaleWidth
    FormOldHeight = formname.ScaleHeight
   
    On Error Resume Next
    For Each obj In formname
        obj.Tag = obj.Left & " " & obj.Top & " " & obj.Width & " " & obj.Height & " "
    Next obj
   
    On Error GoTo 0

End Sub


'按比例改变表单内各元件的大小， 在调用ReSizeForm前先调用ReSizeInit函数

Public Sub resizeform(formname As Form)

Dim pos(4) As Double
Dim i As Long, temppos As Long, startpos As Long
Dim obj As Control
Dim scalex As Double, scaley As Double


scalex = formname.ScaleWidth / FormOldWidth '保存窗体宽度缩放比例
scaley = formname.ScaleHeight / FormOldHeight '保存窗体高度缩放比例

On Error Resume Next

For Each obj In formname
startpos = 1

For i = 0 To 4 '读取控件的原始位置与大小
temppos = InStr(startpos, obj.Tag, " ", vbTextCompare)
If temppos > 0 Then
pos(i) = Mid(obj.Tag, startpos, temppos - startpos)
startpos = temppos + 1
Else
pos(i) = 0
End If

'根据控件的原始位置及窗体改变大小 的比例对控件重新定位与改变大小

obj.Move pos(0) * scalex, pos(1) * scaley, pos(2) * scalex, pos(3) * scaley

Next i

Next obj

On Error GoTo 0

End Sub

强贴,顶了

感觉变得不好看 通常我都禁止 最大化 嘿嘿