AutoSize


Description:
This class automatically resizes all controls on a form to keep them the same size and position, relative the changing dimensions of the form. For instance, if the user resizes the form to twice it's size, the class will automatically double each of the control's widths and heights, double the font size, and reposition the controls so they stay in the same relative positions. I would recommend changing the font of each of the controls you'll be using to a TrueType font to avoid granularity in the fonts as they're resized.
 
Code:
'---------------------------------------------------------------------
' Begin of Class Module: clsAutoSize

Option Explicit

Private Declare Function CopyMemory Lib "kernel32" Alias _
   "RtlMoveMemory" (dest As Any, src As Any, ByVal length As Long) _
   As Long

Private WithEvents m_frmParent As Form 'The parent form to watch

Private Type SizeAndPos ' Used to track the size and position of
    LocLeft As Single   ' child controls
    LocTop As Single
    SizeWidth As Single
    SizeHeight As Single
    FontSize As Single
End Type

Private m_colOrig As Collection ' Collection of sizes for controls,
' actually contains a string for each control that's passed through
' PackUDT/UnPackUDT to see its values

Private m_sizeOrig As SizeAndPos 'The size of the parent form

Private m_nLastPercX As Double ' Last percentage of change of the
Private m_nLastPercY As Double ' parent form, initially 1.0

Private Function PackUDT(tmp As SizeAndPos) As String
    ' PackUDT and UnPackUDT are a little cheat to copy UDT's to and
    ' from strings.  This makes it possible to stuff the UDTs into a
    ' collection, without having to use a dummy class

    PackUDT = Space(Len(tmp))
    
    CopyMemory ByVal PackUDT, tmp, Len(tmp)

End Function

Private Sub UnPackUDT(tmp As SizeAndPos, sIn As String)

    CopyMemory tmp, ByVal sIn, Len(tmp)

End Sub

Public Sub Initialize(frmParent As Form)

    ' Initialize all the member variables
    m_nLastPercX = 1
    m_nLastPercY = 1
    Set m_colOrig = New Collection
    Set m_frmParent = frmParent
    
    Dim ctrl As Control
    Dim tmp As SizeAndPos
    Dim sTemp As String
    
    On Error Resume Next
    
    ' Loop through each control in the controls on the parent form,
    ' and record the starting size and position.  Making sure to
    ' handle controls that don't have a property, such as FontSize.
    
    For Each ctrl In m_frmParent.Controls
        ' Since tmp is used in each iteration, make sure and reset it
        ' to sane values before using it again
        tmp.LocLeft = 0
        tmp.LocTop = 0
        tmp.SizeHeight = 0
        tmp.SizeWidth = 0
        tmp.FontSize = 0

        ' Attempt to read each property, if there's an error,
        ' just put -1 in the UDT
        Err.Clear
        tmp.LocLeft = ctrl.Left
        If Err Then
            tmp.LocLeft = -1
            Err.Clear
        End If
        
        tmp.LocTop = ctrl.Top
        If Err Then
            tmp.LocTop = -1
            Err.Clear
        End If
        
        tmp.SizeHeight = ctrl.Height
        If Err Then
            tmp.SizeHeight = -1
            Err.Clear
        End If
        
        tmp.SizeWidth = ctrl.Width
        If Err Then
            tmp.SizeWidth = -1
            Err.Clear
        End If
        
        tmp.FontSize = ctrl.FontSize
        If Err Then
            tmp.FontSize = -1
            Err.Clear
        End If
        
        'Store the UDT for later use
        m_colOrig.Add PackUDT(tmp), NameOfControl(ctrl)
    Next

    'Make note of the form's starting size
    m_sizeOrig.FontSize = m_frmParent.FontSize
    m_sizeOrig.SizeHeight = m_frmParent.Height
    m_sizeOrig.SizeWidth = m_frmParent.Width

End Sub

Private Function NameOfControl(ByVal ctrl As Control) As String
    ' Simple little function that returns the name of a control,
    ' adding on the index of the control if it has one. Used as
    ' the key in m_colOrig

    On Error Resume Next
    
    NameOfControl = "Control:" & ctrl.Name
    NameOfControl = NameOfControl & ":"
    NameOfControl = NameOfControl & Format(ctrl.Index)
    If Err Then
        Err.Clear
        NameOfControl = NameOfControl & "-1"
    End If

End Function

Private Sub m_frmParent_Resize()
    ' Because m_frmParent is declared WithEvents, this will get
    ' called when the parent form is resized, just like Form_Resize

    If m_frmParent.WindowState = vbMinimized Then
        'Don't do anything if the form is minimized
        Exit Sub
    End If

    Dim nPercX As Double
    Dim nPercY As Double
    Dim tmp As SizeAndPos
    Dim sTemp As String
    Dim ctrl As Control
    
    ' What's the percentage of change from the original?
    nPercX = m_frmParent.Width / m_sizeOrig.SizeWidth
    nPercY = m_frmParent.Height / m_sizeOrig.SizeHeight
    
    ' If the percentage of change exactly matches the last seen
    ' values, don't bother to do anything
    If nPercX = m_nLastPercX And nPercY = m_nLastPercY Then
        Exit Sub
    End If
    
    m_nLastPercX = nPercX
    m_nLastPercY = nPercY
    
    On Error Resume Next
    
    ' Loop through each of the controls, and change it's size and
    ' position to mirror the new size of the form.  Gracefully handle
    ' controls that have appeared since we initialized, or controls
    ' that can't be moved or resized for whatever reason.
    For Each ctrl In m_frmParent.Controls
        
        Err.Clear
        sTemp = m_colOrig.Item(NameOfControl(ctrl))
        If Err Then
            Err.Clear
        Else
            UnPackUDT tmp, sTemp
            
            If tmp.FontSize <> -1 Then
            ' Font size is an odd one.  Should we use the percentage of
            ' change for the width or the height?  I decided to simply
            ' ues the lesser, whichever that may be, but the situtation
            ' might call for something different.
                ctrl.FontSize = tmp.FontSize * _
                   IIf(nPercX < nPercY, nPercX, nPercY)
            End If
            
            ' Here we're protected by an On Error, so if the property
            ' is not -1, just try to change it, if it fails, nothing
            ' we can do, so simply move on to the next property.
            
            If tmp.LocLeft <> -1 Then
                ctrl.Left = tmp.LocLeft * nPercX
            End If
            If tmp.LocTop <> -1 Then
                ctrl.Top = tmp.LocTop * nPercY
            End If
            If tmp.SizeHeight <> -1 Then
                ctrl.Height = tmp.SizeHeight * nPercY
            End If
            If tmp.SizeWidth <> -1 Then
                ctrl.Width = tmp.SizeWidth * nPercX
            End If
        End If
    Next

End Sub

' End of Class Module: clsAutoSize
'---------------------------------------------------------------------

 
Sample Usage:
 
Option Explicit

Private m_AutoSize As clsAutoSize

Private Sub Form_Load()
    
    ' To fully appreciate this example, place a good number of controls on
    ' the example form, and after it's loaded and running, resize the form.
    
    Set m_AutoSize = New clsAutoSize
    m_AutoSize.Initialize Me
    
End Sub