• Home
 · 
• Custom Controls/Forms/Menus
 · 
• Create a Resolution-Independent Form. If a Form takes covers the screen at 640 x 480 resolution, it

Create a Resolution-Independent Form. If a Form takes covers the screen at 640 x 480 resolution, it

Create a Resolution-Independent Form. If a Form takes covers the screen at 640 x 480 resolution, it will take up a small portion of the screen

Rate Create a Resolution-Independent Form. If a Form takes covers the screen at 640 x 480 resolution, it

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

' 1) Change the video resolution to 800 x 600. 
' 2) Start a new project in Visual Basic. Form1 is created by default. 
' 3) Add a Label, a CommandButton, and any other types of controls you would like to test. 

Copy the following code into the Form's module: 
Dim MyForm As FRMSIZE
Dim DesignX As Integer
Dim DesignY As Integer


Private Sub Form_Load()
Dim ScaleFactorX As Single, ScaleFactorY As Single  ' Scaling factors
' Size of Form in Pixels at design resolution
DesignX = 800
DesignY = 600
RePosForm = True   ' Flag for positioning Form
DoResize = False   ' Flag for Resize Event
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips  ' X Pixel Resolution

' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
ScaleMode = 1  ' twips
'Exit Sub  ' uncomment to see how Form1 looks without resizing
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
 "  by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

Private Sub Form_Resize()
Dim ScaleFactorX As Single, ScaleFactorY As Single

If Not DoResize Then  ' To avoid infinite loop
   DoResize = True
   Exit Sub
End If

RePosForm = False
ScaleFactorX = Me.Width / MyForm.Width   ' How much change?
ScaleFactorY = Me.Height / MyForm.Height
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub

Private Sub Command1_Click()
Dim ScaleFactorX As Single, ScaleFactorY As Single

DesignX = Xpixels
DesignY = Ypixels
RePosForm = True
DoResize = False
' Set up the screen values
Xtwips = Screen.TwipsPerPixelX
Ytwips = Screen.TwipsPerPixelY
Ypixels = Screen.Height / Ytwips ' Y Pixel Resolution
Xpixels = Screen.Width / Xtwips  ' X Pixel Resolution

' Determine scaling factors
ScaleFactorX = (Xpixels / DesignX)
ScaleFactorY = (Ypixels / DesignY)
Resize_For_Resolution ScaleFactorX, ScaleFactorY, Me
Label1.Caption = "Current resolution is " & Str$(Xpixels) + _
 "  by " + Str$(Ypixels)
MyForm.Height = Me.Height ' Remember the current size
MyForm.Width = Me.Width
End Sub


' 4) Add a Module from the Project menu and paste in the following code: 

Public Xtwips As Integer, Ytwips As Integer
Public Xpixels As Integer, Ypixels As Integer


Type FRMSIZE
   Height As Long
   Width As Long
End Type

Public RePosForm As Boolean
Public DoResize As Boolean

Sub Resize_For_Resolution(ByVal SFX As Single, _
 ByVal SFY As Single, MyForm As Form)
Dim I As Integer
Dim SFFont As Single

SFFont = (SFX + SFY) / 2  ' average scale
' Size the Controls for the new resolution
On Error Resume Next  ' for read-only or nonexistent properties
With MyForm
  For I = 0 To .Count - 1
   If TypeOf .Controls(I) Is ComboBox Then   ' cannot change Height
     .Controls(I).Left = .Controls(I).Left * SFX
     .Controls(I).Top = .Controls(I).Top * SFY
     .Controls(I).Width = .Controls(I).Width * SFX
   Else
     .Controls(I).Move .Controls(I).Left * SFX, _
      .Controls(I).Top * SFY, _
      .Controls(I).Width * SFX, _
      .Controls(I).Height * SFY
   End If
     .Controls(I).FontSize = .Controls(I).FontSize * SFFont
  Next I
  If RePosForm Then
    ' Now size the Form
    .Move .Left * SFX, .Top * SFY, .Width * SFX, .Height * SFY
  End If
End With
End Sub