回复 第7楼 allanwu244 的帖子
'*在窗体初始化或加载时调用本函数,如在LOAD事件中调用: ResizeInit Me
Public Sub ResizeInit(FormName As Form)
Dim Widget As Control
WidgetOldWidth = FormName.ScaleWidth
WidgetOldHeight = FormName.ScaleHeight
WidgetOldFont = FormName.Font.Size / WidgetOldHeight
On Error Resume Next
For Each Widget In FormName
Widget.Tag = Widget.Left & " " & Widget.TOP & " " & Widget.Width & " " & Widget.Height & " "
Next Widget
End Sub
Public Sub ResizeForm(FormName As Form) '窗体调整时调整控件大小,'如:ResizeForm Me
Dim POS(4) As Double
Dim I As Long, TempPos As Long, StartPos As Long
Dim Widget As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / WidgetOldWidth
'*保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / WidgetOldHeight
'*保存窗体高度缩放比例
On Error Resume Next
Dim K As Integer
For Each Widget In FormName
K = K + 1
StartPos = 1
For I = 0 To 4
'*读取控件的原始位置与大小
TempPos = InStr(StartPos, Widget.Tag, " ", vbTextCompare)
If TempPos > 0 Then
POS(I) = Mid(Widget.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
POS(I) = 0
End If
'*对控件重新定位与改变大小
'Widget.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Next I
'*对控件重新定位与改变大小,
'*不用MOVE方法可以避免有些控件的HEIGHT为只读属性而产生错误
Widget.Left = POS(0) * ScaleX
Widget.TOP = POS(1) * ScaleY
Widget.Width = POS(2) * ScaleX
Widget.Height = POS(3) * ScaleY
Widget.Font.Size = WidgetOldFont * FormName.ScaleHeight
Next Widget
End Sub