Make a Resizing Control
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
0 Comments (click to add your comment)
Networking Solutions
