Resize Form

[D Willett]

Using the following module to resize a form and controls I get error 438 ?
Is there something I need to register in references?

Code: Select all

Private List() As Control
Private curr_obj As Object
Private iHeight As Integer
Private iWidth As Integer
Private x_size As Double
Private y_size As Double
'*****************************************************************************************
'                           LICENSE INFORMATION
'*****************************************************************************************
'   FormControl Version 2.0
'   Code module for resizing a form based on screen size, then resizing the
'   controls based on the forms size
'
'   Copyright (C) 2007
'   Richard L. McCutchen
'   Email: richard@psychocoder.net
'   Created: AUG99
'
'   This program is free software: you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation, either version 3 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program.  If not, see <http://www.gnu.org/licenses/>.
'*****************************************************************************************

Private Type Control
    Index As Integer
    Name As String
    Left As Integer
    Top As Integer
    width As Integer
    height As Integer
End Type

Public Sub ResizeControls(frm As Form)
Dim i As Integer
'   Get ratio of initial form size to current form size
x_size = frm.height / iHeight
y_size = frm.width / iWidth

'Loop though all the objects on the form
'Based on the upper bound of the # of controls
For i = 0 To UBound(List)
    'Grad each control individually
    For Each curr_obj In frm
        'Check to make sure its the right control
        If curr_obj.TabIndex = List(i).Index Then
            'Then resize the control
             With curr_obj
                .Left = List(i).Left * y_size
                .width = List(i).width * y_size
                .height = List(i).height * x_size
                .Top = List(i).Top * x_size
             End With
        End If
    'Get the next control
    Next curr_obj
Next i
End Sub

Public Function SetFontSize() As Integer
    'Make sure x_size is greater than 0
    If Int(x_size) > 0 Then
    'Set the font size
        SetFontSize = Int(x_size * 8)
    End If
End Function

Public Sub GetLocation(frm As Form)
Dim i As Integer
'   Load the current positions of each object into a user defined type array.
'   This information will be used to rescale them in the Resize function.

'Loop through each control
For Each curr_obj In frm
'Resize the Array by 1, and preserve
'the original objects in the array
    ReDim Preserve List(i)
    With List(i)
        .Name = curr_obj
        .Index = curr_obj.TabIndex
        .Left = curr_obj.Left
        .Top = curr_obj.Top
        .width = curr_obj.width
        .height = curr_obj.height
    End With
    i = i + 1
Next curr_obj
    
'   This is what the object sizes will be compared to on rescaling.
    iHeight = frm.height
    iWidth = frm.width
End Sub

Public Sub CenterForm(frm As Form)
    frm.Move (Screen.width - frm.width) \ 2, (Screen.height - frm.height) \ 2
End Sub

Public Sub ResizeForm(frm As Form)
    'Set the forms height
    frm.height = Screen.height / 2
    'Set the forms width
    frm.width = Screen.width / 2
    'Resize all of the controls
    'based on the forms new size
    ResizeControls frm
End Sub

[HansV]

Hi Dave,

Where are you trying to use this? Access, Excel, VB6, VB.NET, ...?

[D Willett]

Hi Hans

It's in a VB6 project:

http://www.dreamincode.net/forums/topic ... -size-vb6/" onclick="window.open(this.href);return false;

[HansV]

Thanks. Where (on which line) do you get the error?

[D Willett]

The error occurs on this line: .Name = curr_obj

Code: Select all

Public Sub GetLocation(frm As Form)
Dim i As Integer
'   Load the current positions of each object into a user defined type array.
'   This information will be used to rescale them in the Resize function.

'Loop through each control
For Each curr_obj In frm
'Resize the Array by 1, and preserve
'the original objects in the array
    ReDim Preserve List(i)
    With List(i)
        .Name = curr_obj
        .Index = curr_obj.TabIndex
        .Left = curr_obj.Left
        .Top = curr_obj.Top
        .width = curr_obj.width
        .height = curr_obj.height
    End With
    i = i + 1
Next curr_obj
    
'   This is what the object sizes will be compared to on rescaling.
    iHeight = frm.height
    iWidth = frm.width
End Sub

[HansV]

Try changing the offending line to

.Name = curr_obj.Name

[D Willett]

Now the error is on this line:.Index = curr_obj.TabIndex

?

[HansV]

In the discussion that follows the code, the errors are pointed out, with some suggestions to correct them. Here is a version with those suggestions incorporated. I can't test it myself because I don't have VB6 any more.

Code: Select all

Private List() As Control
Private curr_obj As Object
Private iHeight As Integer
Private iWidth As Integer
Private x_size As Double
Private y_size As Double

'*****************************************************************************************
'                           LICENSE INFORMATION
'*****************************************************************************************
'   FormControl Version 2.0
'   Code module for resizing a form based on screen size, then resizing the
'   controls based on the forms size
'
'   Copyright (C) 2007
'   Richard L. McCutchen
'   Email: richard@psychocoder.net
'   Created: AUG99
'
'   This program is free software: you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation, either version 3 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program.  If not, see <http://www.gnu.org/licenses/>.
'*****************************************************************************************

Private Type Control
    Name As String
    Left As Integer
    Top As Integer
    Width As Integer
    Height As Integer
End Type

Public Sub ResizeControls(frm As Form)
    On Error Resume Next
    Dim i As Integer
    ' Get ratio of initial form size to current form size
    x_size = frm.Width / iWidth
    y_size = frm.Height / iHeight
    ' Loop though all the control objects in the array
    ' based on the upper bound of the # of controls
    For i = 0 To UBound(List)
        frm(List(i).Name).Left = List(i).Left * x_size
        frm(List(i).Name).Width = List(i).Width * x_size
        frm(List(i).Name).Height = List(i).Height * y_size
        frm(List(i).Name).Top = List(i).Top * y_size
    Next i
End Sub

Public Function SetFontSize() As Integer
    ' Make sure y_size is greater than 0
    If Int(y_size) > 0 Then
    ' Set the font size
        SetFontSize = Int(y_size * 8)
    End If
End Function

Public Sub GetLocation(frm As Form)
    Dim i As Integer
    ' Load the current positions of each object into a user defined type array.
    ' This information will be used to rescale them in the Resize function.

    'Loop through each control
    For Each curr_obj In frm
    ' Resize the Array by 1, and preserve
    ' the original objects in the array
        ReDim Preserve List(i)
        With List(i)
            .Name = curr_obj.Name
            .Left = curr_obj.Left
            .Top = curr_obj.Top
            .Width = curr_obj.Width
            .Height = curr_obj.Height
        End With
        i = i + 1
    Next curr_obj

    ' This is what the object sizes will be compared to on rescaling.
    iHeight = frm.Height
    iWidth = frm.Width
End Sub

Public Sub CenterForm(frm As Form)
    frm.Move (Screen.Width - frm.Width) \ 2, (Screen.Height - frm.Height) \ 2
End Sub

Public Sub ResizeForm(frm As Form)
    ' Set the forms height
    frm.Height = Screen.Height / 2
    ' Set the forms width
    frm.Width = Screen.Width / 2
    ' Resize all of the controls
    ' based on the forms new size
    ResizeControls frm
End Sub

[D Willett]

Cheers Hans
I'll give it a go on Monday.
Many regards.

[D Willett]

Hi Hans ( Thanks )

Seems like this may be a bigger problem than I anticipated.

Runtime error '393':
'Left' property connot be read at run time

I think it's to do with the menu bar ( Menu Editor )

Any suggestions ?

[HansV]

Try changing the GetLocation procedure to

Code: Select all

Public Sub GetLocation(frm As Form)
    Dim i As Integer
    ' Load the current positions of each object into a user defined type array.
    ' This information will be used to rescale them in the Resize function.

    'Loop through each control
    For Each curr_obj In frm
        If TypeOf curr_obj Is Menu Then
            ' Ignore
        Else
            ' Resize the Array by 1, and preserve
            ' the original objects in the array
            ReDim Preserve List(i)
            With List(i)
                .Name = curr_obj.Name
                .Left = curr_obj.Left
                .Top = curr_obj.Top
                .Width = curr_obj.Width
                .Height = curr_obj.Height
            End With
            i = i + 1
        End If
    Next curr_obj

    ' This is what the object sizes will be compared to on rescaling.
    iHeight = frm.Height
    iWidth = frm.Width
End Sub

Again, I cannot test it myself.

[D Willett]

Still the same error I'm afraid ( I know you can't test but really greatful still ) on the same line.

Just doing a Google and here's comments from another forum which may help in the right direction with also having controls on the form !!:

"OK I was playing with this a little more and I can duplicate the error if I place a control on the form that doesn't have a left property. The posted code takes care of the line control but all other controls that don't have a left property are not handled. The main one that would give people problems is the timer control. You should be able to trap that error in the save and resize sub."

[HansV]

Try this version, it should skip controls that don't have a Left property:

Code: Select all

Public Sub GetLocation(frm As Form)
    Dim i As Integer
    Dim n As Integer
    Dim f As Boolean
    ' Load the current positions of each object into a user defined type array.
    ' This information will be used to rescale them in the Resize function.

    'Loop through each control
    For Each curr_obj In frm
        On Error Resume Next
        ' See if we can get the Left property
        n = curr_obj.Left
        f = (Err = 0)
        On Error GoTo 0
        If f Then
            ' Resize the Array by 1, and preserve
            ' the original objects in the array
            ReDim Preserve List(i)
            With List(i)
                .Name = curr_obj.Name
                .Left = curr_obj.Left
                .Top = curr_obj.Top
                .Width = curr_obj.Width
                .Height = curr_obj.Height
            End With
            i = i + 1
        End If
    Next curr_obj

    ' This is what the object sizes will be compared to on rescaling.
    iHeight = frm.Height
    iWidth = frm.Width
End Sub

[D Willett]

Hi Hans

Just had chance to try this, it does work.
Gives me a good basis now to play with the control sizes etc.

Great work Hans, thanks once again.

[HansV]

Where is the :phew: smiley?

[D Willett]

He's gone make a cuppa lol