Microsoft & .NETVisual BasicMake a Resizing Control

Make a Resizing Control

Developer.com content and product recommendations are editorially independent. We may make money when you click on links to our partners. Learn More.

Add a usercontrol (vbsResize) and copy the following code into it:

Option Explicit

'// Are we sizing font?
Private m_blnSizeFont As Boolean

'// Should we keep the ratio?
Private m_blnRatio As Boolean

'// Stores info on each ctrl
Private Type TCtlInfo
    ctrl As Control
    Left As Single
    Top As Single
    Width As Single
    Height As Single
    FontSize As Integer
End Type

'// Controls array
Dim Controls() As TCtlInfo

'// Our parent form
Private WithEvents ParentForm As Form

'// Parent Form's Width and Height
Private m_sngPWidth As Single
Private m_sngPHeight As Single

'// Original ratio of height/width
Private m_sngHWRatio As Single

Private Sub ParentForm_Load()
    m_sngPWidth = 0
    '// Save the original ratio 
    m_sngHWRatio = ParentForm.Height / ParentForm.Width
End Sub

Private Sub ParentForm_Resize()
    If m_sngPWidth = 0 Then
        Rebuild
    Else
        Refresh
    End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    If Ambient.UserMode = False Then Exit Sub
    '// Store the parent form 
    Set ParentForm = Parent
End Sub

Private Sub Rebuild()
    Dim intCount As Integer
    Dim ctrl As Control
    
    On Error Resume Next
    
    If Ambient.UserMode = False Then Exit Sub
    '// Make a reference to the parent 
    Set ParentForm = UserControl.Parent
    '// Store the height and width 
    m_sngPWidth = ParentForm.ScaleWidth
    m_sngPHeight = ParentForm.ScaleHeight
    
    ReDim Controls(ParentForm.Controls.Count - 1) As TCtlInfo
    '// Store the sizes of all the controls 
    For intCount = 0 To ParentForm.Controls.Count - 1
        Set ctrl = ParentForm.Controls(intCount)
        With Controls(intCount)
            Set .ctrl = ctrl
            .Left = ctrl.Left
            .Top = ctrl.Top
            .Width = ctrl.Width
            .Height = ctrl.Height
            .FontSize = ctrl.Font.Size
        End With
    Next
End Sub

Public Sub Refresh()
    Dim intCount As Integer
    Dim ctrl As Control
    Dim sngWFactor As Single
    Dim sngHFactor As Single
    Dim sngMinFactor As Single
    
    Static blnExec As Boolean
    If blnExec Then Exit Sub
    
    If Ambient.UserMode = False Then Exit Sub
    
    If m_blnRatio Then
        blnExec = True
         
         '// Keep the original ratio 
        ParentForm.Height = m_sngHWRatio * ParentForm.Width
        blnExec = False
    End If
    
    On Error Resume Next
    
    sngWFactor = ParentForm.ScaleWidth / m_sngPWidth
    sngHFactor = ParentForm.ScaleHeight / m_sngPHeight
    '// Take the smallest one 
    If sngWFactor < sngHFactor Then 
        sngMinFactor= sngWFactor 
    Else 
        sngMinFactor= sngHFactor 
    End If 
    '// Iterate through the controls
    '// changing their sizes
     For intCount = 0
To UBound(Controls)
        With Controls(intCount)
 
            '// We must resize the font before
            '// the control is resized to account
            '// for scrollbars
            
If m_blnSizeFont Then             
.ctrl.Font.Size = .FontSize * sngMinFactor
End If
    .ctrl.Left = .Left * sngWFactor
    .ctrl.Top = .Top * sngHFactor
    .ctrl.Width = .Width * sngWFactor
    .ctrl.Height = .Height * sngHFactor
End With

Next

End Sub

Get the Free Newsletter!

Subscribe to Developer Insider for top news, trends & analysis

Latest Posts

Related Stories