Article ID: 187232
Article Last Modified on 6/29/2004
Option Explicit
Dim MyBox As PICTSIZE
Private Sub Form_Load()
DoCoolResize = False ' Flag for CoolBar Resize Event
MyBox.Height = Picture1.Height ' Remember the original size
MyBox.Width = Picture1.Width
End Sub
Private Sub Command1_Click()
' Changing CoolBar1.Height will have no effect
CoolBar1.Width = CoolBar1.Width * 1.1 ' grow 10%
End Sub
Private Sub CoolBar1_Resize()
Dim ScaleFactorX As Single, ScaleFactorY As Single
If Not DoCoolResize Then ' To avoid infinite loop
DoCoolResize = True
Exit Sub
End If
ScaleFactorX = Picture1.Width / MyBox.Width ' How much change?
ScaleFactorY = Picture1.Height / MyBox.Height
' UnComment the next line to scale the controls in the PictureBox
'Resize_For_Container ScaleFactorX, ScaleFactorY, Me, _
Picture1, CoolBar1.Name
MyBox.Height = Picture1.Height ' Remember the new size
MyBox.Width = Picture1.Width
End Sub
Type PICTSIZE
Height As Long
Width As Long
End Type
Public DoCoolResize As Boolean
Sub Resize_For_Container(ByVal SFX As Single, _
ByVal SFY As Single, MyForm As Form, _
MyContainer As PictureBox, MyCoolName As String)
Dim I As Integer
Dim SFFont As Single
SFFont = (SFX + SFY) / 2 ' average scale
' Size the Controls for the new container size
On Error Resume Next ' for read-only or nonexistent properties
With MyForm
For I = 0 To .Count - 1
' Do not try to resize the CoolBar or PictureBox
If Not .Controls(I).Name = MyContainer.Name _
And Not .Controls(I).Name = MyCoolName Then
If .Controls(I).Container.Name = MyContainer.Name Then
If TypeOf .Controls(I) Is ComboBox Then ' can't change Height
.Controls(I).Left = .Controls(I).Left * SFX
.Controls(I).Top = .Controls(I).Top * SFY
.Controls(I).Width = .Controls(I).Width * SFX
Else
.Controls(I).Move .Controls(I).Left * SFX, _
.Controls(I).Top * SFY, _
.Controls(I).Width * SFX, _
.Controls(I).Height * SFY
End If
.Controls(I).FontSize = .Controls(I).FontSize * SFFont
End If
End If
Next I
End With
End Sub
Additional query words: kbDSupport kbdsd kbCtrl kbUsage change kbVBp600
Keywords: kbhowto KB187232