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
Thanks
What are in those forms?
Pictures, textboxes, combobox, grids or listbox?
Pictures, textboxes, combobox, grids or listbox?
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
Private Function AddControl(inControl As Control, inName As String) As Long
ReDim Preserve ControlRecord(MaxControl + 1)
On Error Resume Next
ControlRecord(MaxControl).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
try this:
Private Sub Form_load()
Me.Left = 0
Me.Width = Screen.Width
Me.Top = 0
Me.Height = Screen.Height
End Sub
Private Sub Form_load()
Me.Left = 0
Me.Width = Screen.Width
Me.Top = 0
Me.Height = Screen.Height
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
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
FormRecord(MaxForm).Width = pfrmIn.Width
FormRecord(MaxForm).ScaleH
FormRecord(MaxForm).ScaleW
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).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
If TypeOf inControl Is Line Then
ControlRecord(MaxControl).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
Else
ControlRecord(MaxControl).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
ControlRecord(MaxControl).
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).Le
Else
lLeft = CLng((ControlRecord(i).Lef
End If
lTop = CLng((ControlRecord(i).Top
lWidth = CLng((ControlRecord(i).Wid
lHeight = CLng((ControlRecord(i).Hei
If TypeOf inControl Is Line Then
If inControl.X1 < 0 Then
inControl.X1 = CLng(((ControlRecord(i).Le
Else
inControl.X1 = CLng((ControlRecord(i).Lef
End If
inControl.Y1 = CLng((ControlRecord(i).Top
If inControl.X2 < 0 Then
inControl.X2 = CLng(((ControlRecord(i).Wi
Else
inControl.X2 = CLng((ControlRecord(i).Wid
End If
inControl.Y2 = CLng((ControlRecord(i).Hei
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
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.