The perfect resize algorithm... [VB6]

Well I came up with a way to resize a control on a form and it turned out to be rather elegant so I decided to post it here:

In the Form:

VB Code:

Option Explicit
'
Private m_intLastHeight As Integer
Private m_intLastWidth As Integer

and:

VB Code:

Private Sub Form_Load()
    '
    m_intLastHeight = Me.Height
    m_intLastWidth = Me.Width
    '
End Sub

and:

VB Code:

Private Sub Form_Resize()
On Error GoTo Err
    '
    Me.AnyControl.Height = Me.AnyControl.Height + Me.Height - m_intLastHeight
    Me.AnyControl.Width = Me.AnyControl.Width + Me.Width - m_intLastWidth
    '
    m_intLastHeight = Me.Height
    m_intLastWidth = Me.Width
    '
    Exit Sub
Err:
    If Err.Number = 380 Then
        Exit Sub ' This happens when I minimize
    End If
End Sub

Well Dave, I like the idea, but there are a couple of issues for you:

1) Rather than handle the error it is better to not let it happen in the first place (for people like me who log errors, it could get very annoying!)

To fix that, simply put the resizing code inside an If block like this:

VB Code:

If Me.WindowState <> vbMinimized Then
  'Resizing code here
End If

This will also allow you to perform any other funtions in the resize event, without them failing if the form is minimised.

2) Not all controls can be resized, and not all can be set outside of certain limits (I think textbox/combobox have minimum heights). You need to cater for these too ;)

Quote:

---

1) Rather than handle the error it is better to not let it happen in the first place

---

Excellent, I added that.

Quote:

---

2) Not all controls can be resized, and not all can be set outside of certain limits (I think textbox/combobox have minimum heights). You need to cater for these too

---

Agreed. Not all controls are meant to take part in a Form-related resize.

This was mainly for a single RichTextBox Edit control, sort of like a notepad. Obviously you wouldn't want text boxes to grow the way the Form is growing!

I've used similar code which is effective for many apps. I've found things get a little strange sometimes when adding toolbars and menus though.

You're right of course.

A StatusBar can throw a wrench in the works as well, but I dealt with it in my Project by using a Constant to offset by the Height of the StatusBar.

Thank you, this was a great way to do it.
I added a couple of Subs to be able to list the controls I wanted to handle.
One is for moving controls, the other for resizing.
Small contols close to the bottom can stay there (ControleMove)
Large controls (listBox) can resize (ContoleSize)
I'm only interested in Height, you can do the same for width.

Code:

---

' In Form_Resize:

    If Me.WindowState <> vbMinimized Then
        ' Resize these controls
        ControleSize LB_Product(0)
        ControleSize LB_Product(1)
       
        ' Move these controls
        ControleMove Label3
        ControleMove cmd_OK(4)
        ControleMove CB_SuperNode(1)
       
        'Save size
        MintLastHeight = Me.height
       
        ' Reset width, I dont want to allow resizing the width
        If Me.WindowState = vbNormal Then
            Me.width = MintLastWidth
        End If
    End If

---

Code:

---

Sub ControleSize(ctr As Control)
    ctr.height = ctr.height + Me.height - MintLastHeight
    'ctr.width = ctr.width + Me.width - MintLastWidth
End Sub
Sub ControleMove(ctr As Control)
    ctr.Top = ctr.Top + Me.height - MintLastHeight
    ' ctr.width = ctr.width + Me.width - MintLastWidth
End Sub

---

I generally don't like my users to be able to resize the form, so what i wrote is a class that resizes the form and controls on the form based on scale.

This is the form level controls. I allow the users to resized by using Ctrl + Up or Down arrow keys. If there is some sort of problem with the resize they can use Ctrl + R to restore to its original position.

VB Code:

'Form level code
Private mobjResizeForm As clsResizeForm
 
'On form load
Private Sub Form_Load()
Set mobjResizeForm = New clsResizeForm
End Sub
'Form KeyDown
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    'Debug.Print "Form_KeyDown"; Shift; KeyCode
    If Shift = ShiftConstants.vbCtrlMask Then
        Select Case KeyCode
            Case KeyCodeConstants.vbKeyUp
                'ChangeFontSize 2
                mobjResizeForm.ResizeFormBasedOnScale 1.3, 1.3, Me
            Case KeyCodeConstants.vbKeyDown
                'ChangeFontSize -2
                mobjResizeForm.ResizeFormBasedOnScale (1 / 1.3), (1 / 1.3), Me
            Case KeyCodeConstants.vbKeyR
                mobjResizeForm.RestoreFormToOrig Me ', mcolControlPos
        End Select
    End If
End Sub

This is the code from my class. It handles the resizing of all the controls.

VB Code:

'Class To handle resizing of all forms
Option Explicit
'>>>*******************************************************************
'           Private Variables
'>>>*******************************************************************
Private mobjRSControls As ADODB.Recordset
'Private mbolSaveState As Boolean
 
'>>>*******************************************************************
'           Private Properties
'>>>*******************************************************************
Private Property Get mbolSaveState() As Boolean
    mbolSaveState = (mobjRSControls Is Nothing)
End Property
 
'>>>*******************************************************************
'           Public Subs
'>>>*******************************************************************
Public Sub RestoreFormToOrig(ByRef objForm As Form)
    Dim objControl As Control
    If mobjRSControls Is Nothing Then
        GoTo PROC_Exit
    End If
    
    With mobjRSControls
        .Filter = adFilterNone
        .Sort = ""
        
        .Filter = "ControlName = '" & objForm.Name & "'"
        If Not .BOF Then
            .MoveFirst
        End If
        If Not .EOF Then
            objForm.Height = .Fields("Height").Value
            objForm.Width = .Fields("Width").Value
            objForm.Font.SIZE = .Fields("Font").Value
        End If
            
        On Error Resume Next
        For Each objControl In objForm
            .Filter = adFilterNone
            .Sort = ""
            
            .Filter = "ControlName = '" & objControl.Name & "'"
            If Not .BOF Then
                .MoveFirst
            End If
            If Not .EOF Then
                objControl.Font.SIZE = .Fields("Font").Value
                objControl.Height = .Fields("Height").Value
                objControl.Width = .Fields("Width").Value
                objControl.Top = .Fields("Top").Value
                objControl.Left = .Fields("Left").Value
            End If
        Next
    End With
PROC_Exit:
    Set objControl = Nothing
End Sub
 
Public Sub SaveOrigFormSize(ByRef objForm As Form)
On Error Resume Next
    Dim objControl As Control
    
    Set mobjRSControls = New ADODB.Recordset
    With mobjRSControls
        Set .ActiveConnection = Nothing
        .CursorLocation = adUseClient
        .LockType = adLockBatchOptimistic
        With .Fields 'Create the fields that will be apart of this recordset.
            .Append "ControlName", adLongVarChar, 100
            .Append "Height", adDouble
            .Append "Width", adDouble
            .Append "Left", adDouble
            .Append "Top", adDouble
            .Append "Font", adDouble
        End With
        .Open
        
        'Start populating the recordset
        .AddNew
        .Fields("ControlName") = objForm.Name
        .Fields("Height") = objForm.Height
        .Fields("Width") = objForm.Width
        .Fields("Font") = objForm.Font.SIZE
        .UpdateBatch
        For Each objControl In objForm.Controls
            .AddNew
            .Fields("ControlName") = objControl.Name
            .Fields("Height") = objControl.Height
            .Fields("Width") = objControl.Width
            .Fields("Left") = objControl.Left
            .Fields("Top") = objControl.Top
            .Fields("Font") = objControl.Font.SIZE
            .UpdateBatch
        Next
    End With
    Set objControl = Nothing
End Sub
 
 
Public Sub ResizeFormBasedOnScale(ByVal sngSFX As Single, ByVal sngSFY As Single, ByRef objCurForm As Form)
On Error GoTo PROC_Err
    Dim objControl As Control
    Dim sngSFFont As Single
    If mbolSaveState Then
        SaveOrigFormSize objCurForm ', mcolControlPos
    End If
    'mbolSaveState = False
    sngSFFont = (sngSFX + sngSFY) / 2  ' average scale
    ' Size the Controls for the new resolution
    On Error Resume Next  ' for read-only or nonexistent properties
    With objCurForm
        For Each objControl In .Controls 'i = 0 To .Count - 1
            objControl.Left = objControl.Left * sngSFX
            objControl.Top = objControl.Top * sngSFY
            objControl.Width = objControl.Width * sngSFX
            
            If TypeOf objControl Is ComboBox Then
                ' cannot change Height
            Else
                objControl.Height = objControl.Height * sngSFY
            End If
            'I think this code should be inside the above loop and I am moving the same.
            ' Be sure to resize and reposition before changing the FontSize
            objControl.Font.SIZE = objControl.Font.SIZE * sngSFFont
        Next
        'If mbolRePosForm Then
            ' Now size the Form
            '.Move .Left * sngSFX, .Top * sngSFY, .Width * sngSFX, .Height * sngSFY
            .Move .Left, .Top, .Width * sngSFX, .Height * sngSFY
        'End If
    End With
PROC_Exit:
    Set objControl = Nothing
    Exit Sub
PROC_Err:
    If Err.Number = 438 Then
        Resume Next
    Else
        Resume PROC_Exit
    End If
End Sub
 
'>>>*******************************************************************
'           Private Subs
'>>>*******************************************************************
Private Sub Class_Terminate()
    If Not mobjRSControls Is Nothing Then
        If mobjRSControls.State <> adStateClosed Then
            mobjRSControls.Close
        End If
    End If
    Set mobjRSControls = Nothing
End Sub

Hi, I realise this thread is 2.5 years old, but I found this topic via google and it came in very handy for me.

Dave, I used your code, it works very well.

However the control doesn't seem to scale perfectly when the form is resized. This is more noticable the larger you make the form with respect to its original size (ie maximised).

I altered the code by changing this

VB Code:

Me.AnyControl.Height = Me.AnyControl.Height + Me.Height - m_intLastHeight
Me.AnyControl.Width = Me.AnyControl.Width + Me.Width - m_intLastWidth

To this

VB Code:

Me.AnyControl.height = Me.AnyControl.height * (Me.height / m_intLastHeight)
Me.AnyControl.width = Me.AnyControl.width * (Me.width / m_intLastWidth)

And now it seems to work better.

I hope this comes in handy for someone else!


Turkish

Welcome to VBForums :wave:

The problem is caused by a common mistake... using Me.Height and Me.Width (which are the size of the outside of the form, including the title bar etc), rather than Me.ScaleHeight and Me.ScaleWidth (which are the size of the area that controls can be placed in).

Quote:

---

Originally Posted by si_the_geek

Welcome to VBForums :wave:

The problem is caused by a common mistake... using Me.Height and Me.Width (which are the size of the outside of the form, including the title bar etc), rather than Me.ScaleHeight and Me.ScaleWidth (which are the size of the area that controls can be placed in).

---

great tip ill be using this later :D

Hello guys,

I don't remember where i found a similar code like this,
but helped me solve what i wanted to do, Thank You.

C0der