General class code to resize form and its controls.
General class code to resize form and its controls.
API Declarations
Public WithEvents FormX As Form
Private lngFormWidth As Integer
Private lngFormHeight As Integer
Private mWindowLastState As Integer
Private Sub SetInitialization()
Dim ctl As Control
Dim colm As ColumnHeader
lngFormWidth = FormX.ScaleWidth
lngFormHeight = FormX.ScaleHeight
On Error Resume Next
For Each ctl In FormX
ctl.Tag = ctl.Left & " " & ctl.Top & " " & _
ctl.Width & " " & ctl.Height & " "
ctl.Tag = ctl.Tag & ctl.Font.Size
'if form contains ListView Control
For Each colm In ctl.ColumnHeaders
ctl.Tag = ctl.Tag & " " & colm.Width
Next
Next
On Error GoTo 0
End Sub
Private Sub resizeControls()
Dim d() As String
Dim i As Long
Dim TempPoz As Long
Dim ctl As Control
Dim TempVisible As Boolean
Dim ScaleX As Double
Dim ScaleY As Double
ScaleX = FormX.ScaleWidth / lngFormWidth
ScaleY = FormX.ScaleHeight / lngFormHeight
On Error Resume Next
For Each ctl In FormX
TempVisible = ctl.Visible
ctl.Visible = False
d = Split(ctl.Tag, " ")
ctl.Move d(0) * ScaleX, d(1) * ScaleY, _
d(2) * ScaleX, d(3) * ScaleY
ctl.Width = d(2) * ScaleX
ctl.Height = d(3) * ScaleY
' If ScaleX < ScaleY Then
' ctl.Font.Size = d(4) * ScaleX
' Else
' ctl.Font.Size = d(4) * ScaleY
' End If
'if form contains SSTab Control
If ctl.Left < 0 Then
ctl.Left = ctl.Left + (75000 * ScaleX) - 75000
End If
For i = 5 To UBound(d)
ctl.ColumnHeaders(i - 4).Width = d(i) * ScaleX
Next
ctl.Visible = TempVisible
Next ctl
On Error GoTo 0
End Sub
Private Sub Class_Terminate()
Set FormX = Nothing
End Sub
Private Sub FormX_Load()
Call SetInitialization
End Sub
'To avoid resizing controls while minimise<->maximise form
Private Sub FormX_Resize()
Dim mWindowState As Integer
mWindowState = FormX.WindowState
If mWindowState <> 1 And mWindowLastState <> 1 Then
Call resizeControls
mWindowLastState = 2
End If
mWindowLastState = mWindowState
End Sub
(1(1 Vote))