resizeobj.cls

来自「窗体控件随窗体变化大小的类模块,程序时声明对象,参数为该窗体.」· CLS 代码 · 共 54 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ResizeObj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim FormOldWidth, FormOldHeight As Double
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
            MsgBox obj.TypeName
            obj.Tag = obj.Left & "   " & obj.Top & "   " _
                        & obj.Width & "   " & obj.Height & "   "
        Next obj
        On Error GoTo 0
  End Sub
    
  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