Attribute VB_Name = "ResizeForm"
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 0
    
End Sub

'按比例改变表单内各元件的大小，
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm2(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
   
Function ResizeForm(FormName As Form) As Boolean

    With MainForm
        '.Caption = .Height
        If .Width <= 13800 Or .Height <= 10425 Then
            .Width = 13680
            .Height = 10425
        End If
        
        Dim Pos() As Double
        Dim ScaleX As Double, ScaleY As Double
        ScaleX = FormName.ScaleWidth / FormOldWidth
        ScaleY = FormName.ScaleHeight / FormOldHeight
        
        Pos = GetTag(.ListView)
        .ListView.Move Pos(0), Pos(1) * ScaleY, .ScaleWidth - 3440, Pos(3) * ScaleY
        
        Pos = GetTag(.ProgressBar)
        .ProgressBar.Move Pos(0), _
            Pos(1) * ScaleY, _
            MainForm.ListView.Width + .ListView.Left - .ProgressBar.Left, _
            Pos(3) * ScaleY
            
        .LinkFrame.Top = .ListView.Top + .ListView.Height - .LinkFrame.Height
        .Frame1.Top = (.SNText.Top + .SNText.Height) + (.LinkFrame.Top - .Frame1.Height - .ShowText.Height - (.SNText.Top + .SNText.Height)) / 3
        .ShowText.Top = .Frame1.Top + .Frame1.Height + (.LinkFrame.Top - .Frame1.Height - .ShowText.Height - (.SNText.Top + .SNText.Height)) / 3
        '.ShowText.Top = (.Frame1.Top + .Frame1.Height + .LinkFrame.Top - .ShowText.Height) / 2
    End With
End Function

Function GetTag(ByVal Obj As Object) As Double()
    Dim Pos(4) As Double
    Dim i As Long, TempPos As Long, StartPos As Long
    
    With Obj
        StartPos = 1
        For i = 0 To 4
            TempPos = InStr(StartPos, .Tag, "   ", vbTextCompare)
            If TempPos > 0 Then
                Pos(i) = Mid(.Tag, StartPos, TempPos - StartPos)
                StartPos = TempPos + 1
            Else
                Pos(i) = 0
            End If
        Next i
    End With
    GetTag = Pos
End Function