Advertisement
5_2007-2008 Custom Controls/ Forms/ Menus #172873

AutoResize

This code resizes a form and its controls according to the screen resolution. It also takes into account the size of the screen fonts (although this is untested!).

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
'Place the following line in the Form_Load procedure of the form
AutoResize Me, 2 'put a 2 for a full screen form or a 0 for any other form
'Place the following in a module
Sub AutoResize(frmName As Form, winstate As Integer)
Dim designwidth As Integer, designheight As Integer, designfontsize As Integer, currentfontsize As Integer
Dim ratiox As Single, ratioy As Single, numofcontrols As Integer, a As Integer
Dim fontratio As Single
'Change the designwidth and the designheight according to the resolution that the form was designed at
designwidth = 1024
designheight = 768
designfontsize = 96
'Get the current resolution
resx = Screen.Width / Screen.TwipsPerPixelX
resy = Screen.Height / Screen.TwipsPerPixelY
'Work out the ratio for resizing the controls
ratiox = resx / designwidth
ratioy = resy / designheight
'check to see what size of fonts are being used
If IsScreenFontSmall Then
  currentfontsize = 96
Else
  currentfontsize = 120
End If
'work out the ratio for the fontsize
fontratio = currentfontsize / designfontsize
If ratiox = 1 And ratioy = 1 And fontratio = 1 Then Exit Sub
numofcontrols = frmName.Controls.Count - 1
For a = 0 To numofcontrols
  If TypeOf frmName.Controls(a) Is CommandButton Then
    frmName.Controls(a).Width = frmName.Controls(a).Width * ratiox
    frmName.Controls(a).Height = frmName.Controls(a).Height * ratioy
    frmName.Controls(a).Top = frmName.Controls(a).Top * ratioy
    frmName.Controls(a).Left = frmName.Controls(a).Left * ratiox
    frmName.Controls(a).FontSize = frmName.Controls(a).FontSize * ratiox
  ElseIf TypeOf frmName.Controls(a) Is Timer Then
  Else
    frmName.Controls(a).Width = frmName.Controls(a).Width * ratiox
    frmName.Controls(a).Height = frmName.Controls(a).Height * ratioy
    frmName.Controls(a).Top = frmName.Controls(a).Top * ratioy
    frmName.Controls(a).Left = frmName.Controls(a).Left * ratiox
  End If
Next a
If fontratio <> 1 Then
  For a = 0 To numofcontrols
    If TypeOf frmName.Controls(a) Is CommandButton Then
      frmName.Controls(a).Width = frmName.Controls(a).Width * fontratio
      frmName.Controls(a).Height = frmName.Controls(a).Height * fontratio
      frmName.Controls(a).Top = frmName.Controls(a).Top * fontratio
      frmName.Controls(a).Left = frmName.Controls(a).Left * fontratio
      frmName.Controls(a).FontSize = frmName.Controls(a).FontSize * fontratio
    ElseIf TypeOf frmName.Controls(a) Is Timer Then
    Else
      frmName.Controls(a).Width = frmName.Controls(a).Width * fontratio
      frmName.Controls(a).Height = frmName.Controls(a).Height * fontratio
      frmName.Controls(a).Top = frmName.Controls(a).Top * fontratio
      frmName.Controls(a).Left = frmName.Controls(a).Left * fontratio
    End If
    Next a
End If
If winstate = 0 Then
  frmName.Height = frmName.Height * ratioy
  frmName.Width = frmName.Width * ratiox
ElseIf winstate = 2 Then
  frmName.Width = Screen.Width
  frmName.Height = Screen.Height
  frmName.Top = 0
  frmName.Left = 0
End If
End Sub

Public Function IsScreenFontSmall() As Boolean
Dim hWndDesk As Long
Dim hDCDesk As Long
Dim logPix As Long
Dim r As Long
hWndDesk = GetDesktopWindow()
hDCDesk = GetDC(hWndDesk)
logPix = GetDeviceCaps(hDCDesk, LOGPIXELSX)
r = ReleaseDC(hWndDesk, hDCDesk)
If logPix = 96 Then IsScreenFontSmall = True
End Function
Original Comments (3)
Recovered from Wayback Machine