The perfect resize algorithm... [VB6]

[Dave Sell]

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:


Option Explicit
'
Private m_intLastHeight As Integer
Private m_intLastWidth As Integer


and:


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


and:


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

[si_the_geek]

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:

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 ;)

[Dave Sell]

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

Excellent, I added that.

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!

[EricDalnas]

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.

[Dave Sell]

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.

[AndrewR66]

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.

' 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


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

[ProphetBeal]

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.

'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.

'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

[Turkish]

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


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

To this


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

[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).

[illskills]

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

[C0der]

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