Solved

How to resize form programmaticaly to fit on the screen ?

Posted on 2004-08-17
7
334 Views
Last Modified: 2010-05-02
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
0
Comment
Question by:Pkrol1
7 Comments
 
LVL 3

Expert Comment

by:joefm1218
ID: 11820309
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.
0
 
LVL 26

Expert Comment

by:EDDYKT
ID: 11820387
0
 
LVL 7

Expert Comment

by:Jenn3
ID: 11823817
What are in those forms?

Pictures, textboxes, combobox, grids or listbox?
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:Pkrol1
ID: 11826543
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
0
 
LVL 23

Expert Comment

by:Ioannis Paraskevopoulos
ID: 11828141
try this:


Private Sub Form_load()

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

End Sub
0
 
LVL 3

Accepted Solution

by:
joefm1218 earned 500 total points
ID: 11830257
If you throw some controls on a test form, and try the code on this test form, do you get the same error?

If not, then I would guess that an element on your form is breaking this code. I've used this code on fairly complex forms and have had no issue (namely, forms with frames, containers, tabs, control arrays, third party controls, etc.)
0
 

Author Comment

by:Pkrol1
ID: 11840824
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
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

910 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now