Article ID: 182070
Article Last Modified on 3/10/2005
Option Explicit
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
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
' Be sure to resize and reposition before changing the FontSize
.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
Try running this under different screen resolutions and the Form should
take up the same desktop area and retain its look and screen position. You
may notice that your design resizes better when changing to a higher
resolution than it does when changing to a lower one. You can also use the
Mouse to Resize the Form and it will re-scale automatically. Finally, if
you change video resolution while the Form is open, you can click on
Command1 and it adjusts for the new resolution.187562 How To Resize the Controls in SSTab When Form is Resized
253940 PRB: Incorrect Screen Object Width/Height After Desktop Resized
206907 BUG: Reposition or Resize a Control After Changing Font Causes Incorrect Positioning and Sizing
Additional query words: scale
Keywords: kbhowto kbforms kbdisplay KB182070