Option Explicit Private FormOldWidth As Long   '保存窗体的原始宽度Private FormOldHeight As Long   '保存窗体的原始高度 '在调用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 0End 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 0End Sub Private Sub Form_Load()   Call ResizeInit(Me) '在程序装入时必须加入End Sub Private Sub Form_Resize()   Call ResizeForm(Me) '确保窗体改变时控件随之改变End Sub

评论