Link to home
Start Free TrialLog in
Avatar of Pkrol1
Pkrol1

asked on

How to resize form programmaticaly to fit on the screen ?

I have a few screens that are pretty large even for 1280 by 1024 , is there any way to resize them to fit 800 by 600 without  redesigning my screens ?
Thanks
Avatar of joefm1218
joefm1218

Yeah, here is some pretty cool code that will resize any form without touching your current code:

1) In the Form_Resize Event of your form, enter the following code

Private Sub Form_Resize()
    ResizeForm Me
End Sub

2) Create a module and paste in the following code:

Option Explicit

Public Type ctrObj
       Name As String
       Index As Long
       Parrent As String
       Top As Long
       Left As Long
       Height As Long
       Width As Long
       ScaleHeight As Long
       ScaleWidth As Long
End Type

Private FormRecord() As ctrObj
Private ControlRecord() As ctrObj
Private bRunning As Boolean
Private MaxForm As Long
Private MaxControl As Long

Private Function ActualPos(plLeft As Long) As Long
          If plLeft < 0 Then
             ActualPos = plLeft + 75000
          Else
             ActualPos = plLeft
          End If
End Function


Private Function FindForm(pfrmIn As Form) As Long

      Dim i As Long
       FindForm = -1
          If MaxForm > 0 Then
                For i = 0 To (MaxForm - 1)
                          If FormRecord(i).Name = pfrmIn.Name Then
                             FindForm = i
                             Exit Function
                          End If
                Next i
          End If
End Function


Private Function AddForm(pfrmIn As Form) As Long
       Dim FormControl As Control
       Dim i As Long
       ReDim Preserve FormRecord(MaxForm + 1)

      FormRecord(MaxForm).Name = pfrmIn.Name
       FormRecord(MaxForm).Top = pfrmIn.Top
       FormRecord(MaxForm).Left = pfrmIn.Left
       FormRecord(MaxForm).Height = pfrmIn.Height
       FormRecord(MaxForm).Width = pfrmIn.Width
       FormRecord(MaxForm).ScaleHeight = pfrmIn.ScaleHeight
       FormRecord(MaxForm).ScaleWidth = pfrmIn.ScaleWidth
       AddForm = MaxForm
       MaxForm = MaxForm + 1

      For Each FormControl In pfrmIn
         i = FindControl(FormControl, pfrmIn.Name)
         If i < 0 Then
             i = AddControl(FormControl, pfrmIn.Name)
         End If
       Next FormControl
End Function


Private Function FindControl(inControl As Control, inName As String) As Long
       Dim i As Long
       FindControl = -1

      For i = 0 To (MaxControl - 1)
           If ControlRecord(i).Parrent = inName Then
              If ControlRecord(i).Name = inControl.Name Then
                  On Error Resume Next
                  If ControlRecord(i).Index = inControl.Index Then
                        FindControl = i
                        Exit Function
                  End If
                  On Error GoTo 0
              End If
           End If
      Next i
End Function


Private Function AddControl(inControl As Control, inName As String) As Long

      ReDim Preserve ControlRecord(MaxControl + 1)
       On Error Resume Next
       ControlRecord(MaxControl).Name = inControl.Name
       ControlRecord(MaxControl).Index = inControl.Index
       ControlRecord(MaxControl).Parrent = inName

      If TypeOf inControl Is Line Then
          ControlRecord(MaxControl).Top = inControl.Y1
          ControlRecord(MaxControl).Left = ActualPos(inControl.X1)
          ControlRecord(MaxControl).Height = inControl.Y2
          ControlRecord(MaxControl).Width = ActualPos(inControl.X2)
       Else
          ControlRecord(MaxControl).Top = inControl.Top
          ControlRecord(MaxControl).Left = ActualPos(inControl.Left)
          ControlRecord(MaxControl).Height = inControl.Height
          ControlRecord(MaxControl).Width = inControl.Width
      End If

     inControl.IntegralHeight = False
      On Error GoTo 0
      AddControl = MaxControl
      MaxControl = MaxControl + 1
End Function


Private Function PerWidth(pfrmIn As Form) As Long
       Dim i As Long
       i = FindForm(pfrmIn)

      If i < 0 Then
          i = AddForm(pfrmIn)
       End If

      PerWidth = (pfrmIn.ScaleWidth * 100) \ FormRecord(i).ScaleWidth
End Function


Private Function PerHeight(pfrmIn As Form) As Single

      Dim i As Long
       i = FindForm(pfrmIn)

      If i < 0 Then
          i = AddForm(pfrmIn)
       End If

      PerHeight = (pfrmIn.ScaleHeight * 100) \ FormRecord(i).ScaleHeight
End Function


Private Sub ResizeControl(inControl As Control, pfrmIn As Form)

      On Error Resume Next
       Dim i As Long
       Dim widthfactor As Single, heightfactor As Single
       Dim minFactor As Single
       Dim yRatio, xRatio, lTop, lLeft, lWidth, lHeight As Long
       yRatio = PerHeight(pfrmIn)
       xRatio = PerWidth(pfrmIn)
       i = FindControl(inControl, pfrmIn.Name)

      If inControl.Left < 0 Then
          lLeft = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
       Else
          lLeft = CLng((ControlRecord(i).Left * xRatio) \ 100)
       End If

      lTop = CLng((ControlRecord(i).Top * yRatio) \ 100)
       lWidth = CLng((ControlRecord(i).Width * xRatio) \ 100)
       lHeight = CLng((ControlRecord(i).Height * yRatio) \ 100)

      If TypeOf inControl Is Line Then
         If inControl.X1 < 0 Then
              inControl.X1 = CLng(((ControlRecord(i).Left * xRatio) \ 100) - 75000)
         Else
              inControl.X1 = CLng((ControlRecord(i).Left * xRatio) \ 100)
         End If
         inControl.Y1 = CLng((ControlRecord(i).Top * yRatio) \ 100)

        If inControl.X2 < 0 Then
              inControl.X2 = CLng(((ControlRecord(i).Width * xRatio) \ 100) - 75000)
         Else
              inControl.X2 = CLng((ControlRecord(i).Width * xRatio) \ 100)
         End If

        inControl.Y2 = CLng((ControlRecord(i).Height * yRatio) \ 100)
      Else
         inControl.Move lLeft, lTop, lWidth, lHeight
         inControl.Move lLeft, lTop, lWidth
         inControl.Move lLeft, lTop
      End If
End Sub


Public Sub ResizeForm(pfrmIn As Form)

      Dim FormControl As Control
       Dim isVisible As Boolean
       Dim StartX, StartY, MaxX, MaxY As Long
       Dim bNew As Boolean

      If Not bRunning Then
         bRunning = True
         If FindForm(pfrmIn) < 0 Then
               bNew = True
         Else
               bNew = False
         End If

        If pfrmIn.Top < 30000 Then
               isVisible = pfrmIn.Visible
               On Error Resume Next
               If Not pfrmIn.MDIChild Then
                 On Error GoTo 0
                 '     ' pfrmIn.Visible = False
               Else
                 If bNew Then
                  StartY = pfrmIn.Height
                  StartX = pfrmIn.Width
                  On Error Resume Next

                 For Each FormControl In pfrmIn
                       If FormControl.Left + FormControl.Width + 200 > MaxX Then
                          MaxX = FormControl.Left + FormControl.Width + 200
                       End If
                       If FormControl.Top + FormControl.Height + 500 > MaxY Then
                          MaxY = FormControl.Top + FormControl.Height + 500
                       End If
                       If FormControl.X1 + 200 > MaxX Then
                          MaxX = FormControl.X1 + 200
                       End If
                       If FormControl.Y1 + 500 > MaxY Then
                          MaxY = FormControl.Y1 + 500
                       End If
                       If FormControl.X2 + 200 > MaxX Then
                          MaxX = FormControl.X2 + 200
                       End If
                       If FormControl.Y2 + 500 > MaxY Then
                          MaxY = FormControl.Y2 + 500
                       End If
                  Next FormControl
                  On Error GoTo 0
                  pfrmIn.Height = MaxY
                  pfrmIn.Width = MaxX
               End If
               On Error GoTo 0
            End If

           For Each FormControl In pfrmIn
               ResizeControl FormControl, pfrmIn
            Next FormControl

           On Error Resume Next

           If Not pfrmIn.MDIChild Then
               On Error GoTo 0
               pfrmIn.Visible = isVisible
            Else
               If bNew Then
                pfrmIn.Height = StartY
                pfrmIn.Width = StartX

                   For Each FormControl In pfrmIn
                     ResizeControl FormControl, pfrmIn
                Next FormControl
               End If
           End If

          On Error GoTo 0
         End If

         bRunning = False
       End If

End Sub


Public Sub SaveFormPosition(pfrmIn As Form)
       Dim i As Long

      If MaxForm > 0 Then
         For i = 0 To (MaxForm - 1)
             If FormRecord(i).Name = pfrmIn.Name Then
                   FormRecord(i).Top = pfrmIn.Top
                   FormRecord(i).Left = pfrmIn.Left
                   FormRecord(i).Height = pfrmIn.Height
                   FormRecord(i).Width = pfrmIn.Width
                   Exit Sub
              End If
         Next i
         AddForm (pfrmIn)
       End If
End Sub


Public Sub RestoreFormPosition(pfrmIn As Form)
       Dim i As Long

      If MaxForm > 0 Then
          For i = 0 To (MaxForm - 1)
            If FormRecord(i).Name = pfrmIn.Name Then
                 If FormRecord(i).Top < 0 Then
                     pfrmIn.WindowState = 2
                 ElseIf FormRecord(i).Top < 30000 Then
                     pfrmIn.WindowState = 0
                     pfrmIn.Move FormRecord(i).Left, FormRecord(i).Top, FormRecord(i).Width, FormRecord(i).Height
                 Else
                     pfrmIn.WindowState = 1
                 End If
                 Exit Sub
            End If
         Next i
      End If
End Sub

------------------


That's it! When you run your code, try resizing the form. Your will see all controls automatically resize.
What are in those forms?

Pictures, textboxes, combobox, grids or listbox?
Avatar of Pkrol1

ASKER

I am getting an error

Private Function AddControl(inControl As Control, inName As String) As Long

      ReDim Preserve ControlRecord(MaxControl + 1)
       On Error Resume Next
       ControlRecord(MaxControl).Name = inControl.Name
       ControlRecord(MaxControl).Index = inControl.Index <<<<< error out here on frame control
       ControlRecord(MaxControl).Parrent = inName
Avatar of Ioannis Paraskevopoulos
try this:


Private Sub Form_load()

   Me.Left = 0
   Me.Width = Screen.Width
   Me.Top = 0
   Me.Height = Screen.Height

End Sub
ASKER CERTIFIED SOLUTION
Avatar of joefm1218
joefm1218

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Pkrol1

ASKER

Unfortunately I am getting the same error on the same line , it is very strange I am gonna try to use on a brand new form and see what happens