Solved

How to resize form programmaticaly to fit on the screen ?

Posted on 2004-08-17
7
322 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
Comment Utility
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
Comment Utility
0
 
LVL 7

Expert Comment

by:Jenn3
Comment Utility
What are in those forms?

Pictures, textboxes, combobox, grids or listbox?
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:Pkrol1
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
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.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

771 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

11 Experts available now in Live!

Get 1:1 Help Now