ClsResize

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Sub ResizeForm(ByRef aForm As Form)
Dim controlCounter As Integer 'number of controls on a form.
Dim screenSize As Integer 'get the screen size from api call.
Dim sizeFactor As Single ' determine the factor For sizing
'800 x 600 is assumed 1 to 1.

Dim fntSize As Integer 'Hold adjusted font size.
Dim SM_CXSCREEN As Integer 'Pass this constant To GetSystemMetrics so that it
SM_CXSCREEN = 0 'returns the screen size On the x axis.
screenSize = GetSystemMetrics(SM_CXSCREEN)
sizeFactor = 0 'initialize size factor.
Select Case screenSize
'640 x 480

Case 640:
sizeFactor = 0.8
'720 x 480

Case 720:
sizeFactor = 0.9
'800 x 600

Case 800:
sizeFactor = 1
'1024 x 768

Case 1024:
sizeFactor = 1.28
'1152 x 864

Case 1152:
sizeFactor = 1.44
'1280 x 1024

Case 1280:
sizeFactor = 1.6
End Select
'if sizeFactor was uninitialized take care of it.

If sizeFactor = 0 Then
sizeFactor = 1
End If
controlCounter = -1 'Set the control counter.
'Reset the width and height of the form itself

aForm.Width = aForm.Width * sizeFactor
aForm.Height = aForm.Height * sizeFactor
'Reset the width, height, left, and top properties for each of the

'visible controls on the form.

For Each Control In aForm
'This next line will allow for skipping controls that have

'no width or left properties.

On Error Resume Next
controlCounter = controlCounter + 1
aForm.Controls(controlCounter).Width = aForm.Controls(controlCounter).Width * sizeFactor
aForm.Controls(controlCounter).Left = aForm.Controls(controlCounter).Left * sizeFactor
aForm.Controls(controlCounter).Height = aForm.Controls(controlCounter).Height * sizeFactor
aForm.Controls(controlCounter).Top = aForm.Controls(controlCounter).Top * sizeFactor
'If the control has a font property adjust the font size also.

'You can add additional control types tomeet your needs.

If TypeOf aForm.Controls(controlCounter) Is CommandButton Or _
TypeOf aForm.Controls(controlCounter) Is TextBox Or _
TypeOf aForm.Controls(controlCounter) Is Label Or _
TypeOf aForm.Controls(controlCounter) Is ComboBox Or _
TypeOf aForm.Controls(controlCounter) Is ListBox Or _
TypeOf aForm.Controls(controlCounter) Is CheckBox Or _
TypeOf aForm.Controls(controlCounter) Is OptionButton Or _
TypeOf aForm.Controls(controlCounter) Is Frame Or _
TypeOf aForm.Controls(controlCounter) Is DirListBox Or _
TypeOf aForm.Controls(controlCounter) Is StatusBar Or _
TypeOf aForm.Controls(controlCounter) Is RichTextBox Then
fntSize = aForm.Controls(controlCounter).Font.Size 'Get current font size
fntSize = fntSize * sizeFactor 'get a new Integer value For font size.
aForm.Controls(controlCounter).Font.Size = fntSize 'Reset the font size.
End If
Next
End Sub

This routine has now been written as a class so all you
have to do is cut and paste the code into a class module,
instantiate the class and call the resizeForm method in the
form load event of any form you want to use it with. To use
the resizeForm method you must pass it the form by reference.
For example:

Private Sub Form_Load()
Dim resize As New clsResize
resize.ResizeForm Me
End sub