ASP_Volume2 Custom Controls/ Forms/ Menus #32670
AutoResize version 2

Name: AutoResize version 2
Brand: Planet Source Code
SKU: PSC-32670
Availability: InStock
Rating: 4.5 (720 reviews)
Author: Mark Parter
Mark Parter
★★★★★
4.8 · 다운로드 수: 2,341
This code resizes a form and it's controls (and fonts) according to the users resolution.
AI 요약: 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.
소스 코드
PLACE THE FOLLOWING CODE INTO A MODULE:

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
Exit Function
End Function
--------------------------------------------------------
Sub ResizeControls(frmName As Form, winstate As Integer)
On Error Resume Next
Dim designwidth As Integer, designheight As Integer, designfontsize As Integer, currentfontsize As Integer
Dim numofcontrols As Integer, a As Integer
Dim movetype As String, moveamount As Integer
'Change the designwidth and the designheight according to the resolution that the form was designed at
designwidth = 1024
designheight = 768
designfontsize = 96
GetResolutionX = Screen.Width / Screen.TwipsPerPixelX
GetResolutionY = Screen.Height / Screen.TwipsPerPixelY
'Work out the ratio for resizing the controls
ratiox = GetResolutionX / designwidth
ratioy = GetResolutionY / 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 = designfontsize / currentfontsize
If ratiox = 1 And ratioy = 1 And fontratio = 1 Then Exit Sub
numofcontrols = frmName.Controls.Count - 1 'count the number of controls on the form

If winstate = 0 Then 'if the form isn't fullscreen then
  frmName.Height = frmName.Height * ratioy
  frmName.Width = frmName.Width * ratiox
  If frmName.Tag <> "" Then
    movetype = Left(frmName.Tag, 1)
    moveamount = Mid(frmName.Tag, 2, Len(frmName.Tag))
    Select Case movetype
      Case "L"
        frmName.Left = frmName.Left + moveamount
      Case "T"
        frmName.Top = frmName.Top + moveamount
      Case "H"
        frmName.Height = frmName.Height + moveamount
      Case "W"
        frmName.Width = frmName.Width + moveamount
    End Select
  End If
ElseIf winstate = 2 Then 'otherwise if it is fullscreen then
  frmName.Width = Screen.Width
  frmName.Height = Screen.Height
  frmName.Top = 0
  frmName.Left = 0
End If
For a = 0 To numofcontrols 'loop through each control
  If frmName.Controls(a).Font.Size <= 8 And ratiox < 1 Then
    frmName.Controls(a).Font.Name = "Small Fonts"
    frmName.Controls(a).Font.Size = frmName.Controls(a).Font.Size - 0.5
  Else
    frmName.Controls(a).Font.Size = frmName.Controls(a).Font.Size * ratiox
  End If
  If TypeOf frmName.Controls(a) Is Line Then
    frmName.Controls(a).X1 = frmName.Controls(a).X1 * ratiox
    frmName.Controls(a).Y1 = frmName.Controls(a).Y1 * ratioy
    frmName.Controls(a).X2 = frmName.Controls(a).X2 * ratiox
    frmName.Controls(a).Y2 = frmName.Controls(a).Y2 * ratioy
  
  ElseIf TypeOf frmName.Controls(a) Is PictureBox 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).ScaleHeight = frmName.Controls(a).ScaleHeight * ratioy
    frmName.Controls(a).ScaleWidth = frmName.Controls(a).ScaleWidth * ratiox
  ElseIf TypeOf frmName.Controls(a) Is Toolbar Then
    frmName.Controls(a).ButtonHeight = frmName.Controls(a).ButtonHeight * ratioy
    frmName.Controls(a).ButtonWidth = frmName.Controls(a).ButtonWidth * ratiox
    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
  ElseIf TypeOf frmName.Controls(a) Is MSFlexGrid Then
    frmName.Controls(a).ColWidth = frmName.Controls(a).ColWidth * ratiox
    frmName.Controls(a).RowHeight = frmName.Controls(a).RowHeight * ratioy
    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
  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
  If frmName.Controls(a).Tag <> "" Then
    movetype = Left(frmName.Controls(a).Tag, 1)
    moveamount = Mid(frmName.Controls(a).Tag, 2, Len(frmName.Controls(a).Tag))
    Select Case movetype
      Case "L"
        frmName.Controls(a).Left = frmName.Controls(a).Left + moveamount
      Case "T"
        frmName.Controls(a).Top = frmName.Controls(a).Top + moveamount
      Case "H"
        frmName.Controls(a).Height = frmName.Controls(a).Height + moveamount
      Case "W"
        frmName.Controls(a).Width = frmName.Controls(a).Width + moveamount
    End Select
  End If
Next a
If fontratio <> 1 Then
  If winstate = 0 Then
    frmName.Height = frmName.Height * fontratio
    frmName.Width = frmName.Width * fontratio
    If frmName.Tag <> "" Then
      movetype = Left(frmName.Tag, 1)
      moveamount = Mid(frmName.Tag, 2, Len(frmName.Tag))
      Select Case movetype
        Case "L"
          frmName.Left = frmName.Left + moveamount
        Case "T"
          frmName.Top = frmName.Top + moveamount
        Case "H"
          frmName.Height = frmName.Height + moveamount
        Case "W"
          frmName.Width = frmName.Width + moveamount
      End Select
    End If
  ElseIf winstate = 2 Then
    frmName.Width = Screen.Width
    frmName.Height = Screen.Height
    frmName.Top = 0
    frmName.Left = 0
  End If
  For a = 0 To numofcontrols
    If frmName.Controls(a).Font.Size <= 8 And fontratio < 1 Then
      frmName.Controls(a).Font.Name = "Small Fonts"
      frmName.Controls(a).Font.Size = frmName.Controls(a).Font.Size - 0.5
    Else
      frmName.Controls(a).Font.Size = frmName.Controls(a).Font.Size * fontratio
    End If
  If TypeOf frmName.Controls(a) Is Line Then
    frmName.Controls(a).X1 = frmName.Controls(a).X1 * fontratio
    frmName.Controls(a).Y1 = frmName.Controls(a).Y1 * fontratio
    frmName.Controls(a).X2 = frmName.Controls(a).X2 * fontratio
    frmName.Controls(a).Y2 = frmName.Controls(a).Y2 * fontratio
  
  ElseIf TypeOf frmName.Controls(a) Is PictureBox 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).ScaleHeight = frmName.Controls(a).ScaleHeight * fontratio
    frmName.Controls(a).ScaleWidth = frmName.Controls(a).ScaleWidth * fontratio
  ElseIf TypeOf frmName.Controls(a) Is Toolbar Then
    frmName.Controls(a).ButtonHeight = frmName.Controls(a).ButtonHeight * fontratio
    frmName.Controls(a).ButtonWidth = frmName.Controls(a).ButtonWidth * fontratio
    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
  ElseIf TypeOf frmName.Controls(a) Is MSFlexGrid Then
    frmName.Controls(a).ColWidth = frmName.Controls(a).ColWidth * fontratio
    frmName.Controls(a).RowHeight = frmName.Controls(a).RowHeight * fontratio
    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
  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
End Sub
PLACE THE FOLLOWING CODE INTO THE FORM_LOAD EVENT OF THE FORM:
ResizeControls Me, x (replace the x with a 2 for a fullscreen form or a 0 for any other size of form.)
원본 댓글 (3)
Wayback Machine에서 복구됨