RESIZING ALL CONTENTS OF A WINDOW? 13

dabineri · Oct 27, 2006

What is the preferred way, in VB6, to create a window that can be re-sized in such a way as all the controls on that window automatically resize also as the window changes?

Thanks for any advice on this, David Abineri

Golom · Oct 28, 2006

I use this class called "FormReSize"

Code:

Option Explicit

Private Type ControlPositionType
    CtlName                         As String
    CtlType                         As String
    Left                            As Single
    Top                             As Single
    Width                           As Single
    Height                          As Single
    FontSize                        As Single
    FontName                        As String
End Type

Private m_ControlPositions()        As ControlPositionType
Private m_FormWid                   As Single
Private m_FormHgt                   As Single
Private m_MaxFontGrowthPercent      As Single
Private m_MinFontGrowthPercent      As Single

Public Property Let MaxFontGrowthPercent(vData As Single)
    m_MaxFontGrowthPercent = vData
End Property

Public Property Let MinFontGrowthPercent(vData As Single)
    m_MinFontGrowthPercent = vData
End Property


' Save the form's and controls' dimensions.
Public Sub SaveSizes(Frm As Form)
    Dim i                           As Integer
    Dim Ctl                         As Control
    ' Save the controls' positions and sizes.
    ReDim m_ControlPositions(1 To Frm.Controls.Count)
    i = 1
    For Each Ctl In Frm.Controls
        If Not TypeOf Ctl Is Timer Then
            With m_ControlPositions(i)
                .CtlName = Ctl.Name
                .CtlType = TypeName(Ctl)
                If TypeOf Ctl Is Line Then
                    .Left = Ctl.X1
                    .Top = Ctl.Y1
                    .Width = Ctl.X2 - Ctl.X1
                    .Height = Ctl.Y2 - Ctl.Y1
                Else
                    On Error Resume Next
                    .Left = Ctl.Left
                    .Top = Ctl.Top
                    .Width = Ctl.Width
                    .Height = Ctl.Height
                    .FontSize = Ctl.Font.Size
                    .FontName = Ctl.Font.Name
                    On Error GoTo 0
                End If
            End With
            i = i + 1
        End If
    Next Ctl

    ' Save the form's size.
    m_FormWid = Frm.ScaleWidth
    m_FormHgt = Frm.ScaleHeight

End Sub

' Arrange the controls for the new size.
Public Sub ResizeControls(Frm As Form)
    Dim i                           As Integer
    Dim Ctl                         As Control
    Dim x_scale                     As Single
    Dim y_scale                     As Single
    Dim NewFontSize                 As Single
    Dim MGrowth                     As Single
    Dim NGrowth                     As Single
    MGrowth = 1# + (m_MaxFontGrowthPercent / 100#)
    NGrowth = 1# - (m_MinFontGrowthPercent / 100#)

    ' Don't bother if we are minimized.
    If Frm.WindowState = vbMinimized Then Exit Sub

    ' Get the form's current scale factors.
    x_scale = Frm.ScaleWidth / m_FormWid
    y_scale = Frm.ScaleHeight / m_FormHgt

    ' Position the controls.
    i = 1
    For Each Ctl In Frm.Controls

        If Not TypeOf Ctl Is Timer Then
            With m_ControlPositions(i)

                If Not .CtlType = "StatusBar" Then
                    If TypeOf Ctl Is Line Then
                        Ctl.X1 = x_scale * .Left
                        Ctl.Y1 = y_scale * .Top
                        Ctl.X2 = Ctl.X1 + x_scale * .Width
                        Ctl.Y2 = Ctl.Y1 + y_scale * .Height
                    Else
                        On Error Resume Next
                        Ctl.Left = x_scale * .Left
                        Ctl.Top = y_scale * .Top
                        Ctl.Width = x_scale * .Width
                        If Not (TypeOf Ctl Is ComboBox) Then
                            ' Cannot change height of ComboBoxes.
                            Ctl.Height = y_scale * .Height
                        End If
                        NewFontSize = y_scale * .FontSize
                        ' Limit font growth to MGrowth%
                        If NewFontSize > .FontSize * MGrowth Then
                            NewFontSize = .FontSize * MGrowth
                        End If
                        ' Limit font shrink to NGrowth%
                        If NewFontSize < .FontSize * NGrowth Then
                            NewFontSize = .FontSize * NGrowth
                        End If
                        If NewFontSize < 7 Then
                            If Ctl.Font.Name <> "Small Fonts" Then Ctl.Font.Name = "Small Fonts"
                        ElseIf NewFontSize >= 7 Then
                            If Ctl.Font.Name = "Small Fonts" Then Ctl.Font.Name = .FontName
                        End If
                        Ctl.Font.Size = NewFontSize
                        On Error GoTo 0
                    End If
                End If

            End With
            i = i + 1
        End If
    Next Ctl

End Sub

Private Sub Class_Initialize()
    m_MaxFontGrowthPercent = 25
    m_MinFontGrowthPercent = 40
End Sub

and in a form

Code:

[COLOR=black cyan]' General Declarations Section [/color]
Dim RSZ as FormReSize

Private Sub Form_Load()
   Set RSZ = New FormReSize
   RSZ.SaveSizes
End Sub

Private Sub Form_Resize()
   RSZ.ResizeControls
End Sub

[red]WARNING:[/red] This does not work with tabbed controls.

dabineri · Oct 28, 2006

Golom, Thanks so much for posting this it looks like what I need. Three questions though.
What is a tabbed control?
Will I be able to use this on a TrueDB grid on my form?
I have not programmed a CLASS before. Where does this reside in the project (VB6)?

Thanks again for your help, David Abineri

Golom · Oct 29, 2006

The most common tabbed control is Microsoft Tabbed Dialog Control 6.0 (SP6) (TABCTL32.OCX).

That control has multiple tabs and you can place different controls in different tabs. The control works by setting the .Left property of controls that are not on the current page to some negative value (i.e. off the screen). When this FormResize code attempts to reposition those controls it doesn't do it properly so the tabbed dialog control can't position them back to their correct positions on the screen.

I have not used a TrueDB control so I can't say that I've tested it but presumably it has the usual .Left, .Top, etc. properties so it should work.

In the IDE, select "Project / Add Class Module" and add a new class. It will be added to the Classes collection and will be called "Class1". Change the name to "FormResize" and then paste the above code into it.

Just a small revision to the code to use it

Code:

[COLOR=black cyan]' General Declarations Section[/color]
Dim RSZ as FormReSize

Private Sub Form_Load()
   Set RSZ = New FormReSize
   RSZ.SaveSizes [red]Me[/red]
End Sub

Private Sub Form_Resize()
   RSZ.ResizeControls [red]Me[/red]
End Sub

dabineri · Oct 29, 2006

Thank you again for your very clear and complete answers!

David Abineri

harebrain · Oct 30, 2006

Well, I'll hang a star on that!

I do think I'd check for controls of type CommonDialog along with Timer, even though the error trapping will keep things safe. I suppose it's a matter of personal preference as far as invisible controls go.

BobRodes · Oct 31, 2006

Well, I'll hang a star on that. Harebrain forgot. ;-) Golom, very useful piece of code. I'm archiving, and thanks for sharing.

Bob

harebrain · Nov 1, 2006

Doh! Ergo my handle!

suoirotciv · Nov 7, 2006

this is really great . . . thanks a lot

========================================
I kept my Job because of TEK-TIPS
Thanks a lot to all who keeps on helping others.

Golom · Nov 7, 2006

It seems that whenever I post something like this, I inevitably discover that I've missed something that should have been there. In this specific case, Head Fonts.

Here's an altered version that handles controls like data grids that have a HeadFont property.

Code:

Option Explicit

Private Type ControlPositionType
    CtlName                         As String
    CtlType                         As String
    Left                            As Single
    Top                             As Single
    Width                           As Single
    Height                          As Single
    FontSize                        As Single
    FontName                        As String
    HeadFontSize                    As Single
    HeadFontName                    As String
End Type

Private m_ControlPositions()        As ControlPositionType
Private m_FormWid                   As Single
Private m_FormHgt                   As Single
Private m_MaxFontGrowthPercent      As Single
Private m_MinFontGrowthPercent      As Single

Public Property Let MaxFontGrowthPercent(vData As Single)
    m_MaxFontGrowthPercent = vData
End Property

Public Property Let MinFontGrowthPercent(vData As Single)
    m_MinFontGrowthPercent = vData
End Property


' Save the form's and controls' dimensions.
Public Sub SaveSizes(frm As Form)
    Dim i                           As Integer
    Dim Ctl                         As Control
    
    ' Save the controls' positions and sizes.
    ReDim m_ControlPositions(1 To frm.Controls.Count)
    i = 1
    For Each Ctl In frm.Controls
        If Not TypeOf Ctl Is Timer Then
            With m_ControlPositions(i)
                .CtlName = Ctl.Name
                .CtlType = TypeName(Ctl)
                If TypeOf Ctl Is Line Then
                    .Left = Ctl.X1
                    .Top = Ctl.Y1
                    .Width = Ctl.X2 - Ctl.X1
                    .Height = Ctl.Y2 - Ctl.Y1
                Else
                    On Error Resume Next
                    .Left = Ctl.Left
                    .Top = Ctl.Top
                    .Width = Ctl.Width
                    .Height = Ctl.Height
                    .FontSize = Ctl.Font.Size
                    .FontName = Ctl.Font.Name
                    ' For those controls that have a Head Font as 
                    ' well as a regular Font Property
                    .HeadFontName = Ctl.HeadFont.Name
                    .HeadFontSize = Ctl.HeadFont.Size
                    On Error GoTo 0
                End If
            End With
            i = i + 1
        End If
    Next Ctl

    ' Save the form's size.
    m_FormWid = frm.ScaleWidth
    m_FormHgt = frm.ScaleHeight

End Sub

' Arrange the controls for the new size.
Public Sub ResizeControls(frm As Form)
    Dim i                           As Integer
    Dim Ctl                         As Control
    Dim x_scale                     As Single
    Dim y_scale                     As Single
    Dim NewFontSize                 As Single
    Dim MGrowth                     As Single
    Dim NGrowth                     As Single
    
    MGrowth = 1# + (m_MaxFontGrowthPercent / 100#)
    NGrowth = 1# - (m_MinFontGrowthPercent / 100#)

    ' Don't bother if we are minimized.
    If frm.WindowState = vbMinimized Then Exit Sub

    ' Get the form's current scale factors.
    x_scale = frm.ScaleWidth / m_FormWid
    y_scale = frm.ScaleHeight / m_FormHgt

    ' Position the controls.
    i = 1
    For Each Ctl In frm.Controls

        If Not TypeOf Ctl Is Timer Then
            With m_ControlPositions(i)

                If Not .CtlType = "StatusBar" Then
                    If TypeOf Ctl Is Line Then
                        Ctl.X1 = x_scale * .Left
                        Ctl.Y1 = y_scale * .Top
                        Ctl.X2 = Ctl.X1 + x_scale * .Width
                        Ctl.Y2 = Ctl.Y1 + y_scale * .Height
                    Else
                        On Error Resume Next
                        Ctl.Left = x_scale * .Left
                        Ctl.Top = y_scale * .Top
                        Ctl.Width = x_scale * .Width
                        ' Cannot change height of ComboBoxes.
                        If Not (TypeOf Ctl Is ComboBox) Then    
                            Ctl.Height = y_scale * .Height
                        End If

                        ' Adjust the Fonts
                        NewFontSize = y_scale * .FontSize
                        ' Limit font growth between MaxFontGrowth and MinFontGrowth
                        If NewFontSize > .FontSize * MGrowth Then NewFontSize = .FontSize * MGrowth
                        If NewFontSize < .FontSize * NGrowth Then NewFontSize = .FontSize * NGrowth

                        If NewFontSize < 7 Then
                            If Ctl.Font.Name <> "Small Fonts" Then Ctl.Font.Name = "Small Fonts"
                        ElseIf NewFontSize >= 7 Then
                            If Ctl.Font.Name = "Small Fonts" Then Ctl.Font.Name = .FontName
                        End If
                        Ctl.Font.Size = NewFontSize

                        ' Handle controls with a Head Font
                        Err.Clear
                        NewFontSize = Ctl.HeadFont.Size
                        If Err.Number = 0 Then
                            NewFontSize = y_scale * .HeadFontSize
                            ' Limit font growth between MaxFontGrowth and MinFontGrowth
                            If NewFontSize > .HeadFontSize * MGrowth Then NewFontSize = .HeadFontSize * MGrowth
                            If NewFontSize < .HeadFontSize * NGrowth Then NewFontSize = .HeadFontSize * NGrowth

                            If NewFontSize < 7 Then
                                If Ctl.HeadFont.Name <> "Small Fonts" Then Ctl.HeadFont.Name = "Small Fonts"
                            Else
                                If Ctl.HeadFont.Name = "Small Fonts" Then Ctl.HeadFont.Name = .HeadFontName
                            End If
                            Ctl.HeadFont.Size = NewFontSize
                        End If

                        On Error GoTo 0
                    End If
                End If

            End With
            i = i + 1
        End If
    Next Ctl

End Sub

Private Sub Class_Initialize()
    m_MaxFontGrowthPercent = 25
    m_MinFontGrowthPercent = 40
End Sub

harebrain · Nov 7, 2006

Thanks for the update!

JWAmpK1 · Nov 29, 2006

I was going along good till I got to the bottom.
What is a 'HEAD FONT'?

Golom · Nov 30, 2006

If you use DbGrid (DAO) or DataGrid (ADO) controls, they have two font properties. One for the items in the grid and one for the caption and column headings. If you just set the grid's "font" property then you are setting the font for the grid's contents. If you set the "HeadFont" property then the caption and column headings are changed.

This code just adjust's font sizes for both the "Font" and "HeadFont" properties for those controls.

dabineri · Dec 25, 2006

Golom, This code works great, thanks so much!

One question. As I resize the form, the TDBGrid resizes but the columns all remain the same size presumeably because I gave them an absolute width. What is the best way to have the columns all change in proportion to the overall grid size so that it all 'looks' correct?

Thanks again for all your help

David Abineri

dabineri · Dec 25, 2006

Golom, After resizing a form and all its controls, how do I save the current settings so that when re opening that form all the sizes are as they were when it closed?

Thanks again for all your help on this.

David Abineri

johnwm · Dec 26, 2006

Although I'm not Golom, the easy and standard answer is to store the window size settings in the registry and retrieve them when your program loads, then run Golom's code.

You can either use SaveSetting and GetSetting direct from VB (see VBHelp, SaveSetting statement), or use the registry APIs (example at

http://www.allapi.net/apilist/RegSaveKey.shtml)

There are also examples of both techniques illustrated on this forum

___________________________________________________________
If you want the best response to a question, please check out FAQ222-2244 first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Drive a Steam Roller
Steam Engine Prints

Golom · Dec 26, 2006

OK. Here's the other class that I use a lot. It's called ColWidths

Code:

'-----------------------------------------------------------
' Module    : ColWidths
' Purpose   : Save and/or restore user column widths in a dbgrid.
'-----------------------------------------------------------

Option Explicit

Private mvarFormName                As String
Private mvarGrid                    As DBGrid
Private AppSet                      As String
Private mvarIniFile                 As String

Private Declare Function GetPrivateProfileString _
                         Lib "kernel32" Alias "GetPrivateProfileStringA" _
                             (ByVal lpSectionName As String, _
                              ByVal lpKeyName As Any, _
                              ByVal lpDefault As String, _
                              ByVal lpReturnedString As String, _
                              ByVal nSize As Long, _
                              ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString _
                         Lib "kernel32" Alias "WritePrivateProfileStringA" _
                             (ByVal lpSectionName As String, _
                              ByVal lpKeyName As Any, _
                              ByVal lpString As Any, _
                              ByVal lpFileName As String) As Long

'-----------------------------------------------------------
' Procedure : LET FormName
' Purpose   : Record the name of the form
'-----------------------------------------------------------
'
Public Property Let FormName(vData As String)
    mvarFormName = vData
End Property

'-----------------------------------------------------------
' Procedure : SET Grid
' Purpose   : Get a reference to the grid object
'-----------------------------------------------------------
'
Public Property Set Grid(vData As DBGrid)
    Set mvarGrid = vData
End Property

'-----------------------------------------------------------
' Procedure : GET Grid
' Purpose   : Return the grid object
'-----------------------------------------------------------
'
Public Property Get Grid() As DBGrid
    Set Grid = mvarGrid
End Property

'-----------------------------------------------------------
' Procedure : GetWidths
' Purpose   : Load the stuff that was saved in the ini file and set the widths
'-----------------------------------------------------------
'
Public Sub GetWidths(Optional Qualifier As String = "")

    Dim CW()                        As String
    Dim st()                        As String
    Dim n                           As Integer
    Dim SetString                   As String

    AppSet = mvarFormName & mvarGrid.Name & Qualifier

    ' Retrieve the settings.
    SetString = ProfileGetItem("WIDTHS", AppSet, mvarIniFile)

    If Len(SetString) = 0 Then
        ' Set the Initial settings if none were found in the 'ini' file.
        SetWidths mvarGrid, Qualifier
        SetString = ProfileGetItem("WIDTHS", AppSet, mvarIniFile)
    End If

    CW = Split(SetString, ",")
    For n = 0 To UBound(CW)
        st = Split(CW(n), ";")
        mvarGrid.Columns(n).Width = Val(st(0))
        If UBound(st) > 0 Then mvarGrid.Columns(n).Visible = (st(1) = "T")
        If n = mvarGrid.Columns.Count - 1 Then Exit For
    Next

End Sub


'-----------------------------------------------------------
' Procedure : SetWidths
' Purpose   : Record the current column widths in the ini file.
'-----------------------------------------------------------
'
Public Sub SetWidths(ByRef vData As DBGrid, Optional Qualifier As String = "")

    Dim n                           As Integer
    Dim cBuf                        As String
    Dim Vis                         As String
    ' Set the Initial settings if none were found in the 'ini' file.
    cBuf = ""
    AppSet = mvarFormName & mvarGrid.Name & Qualifier
    For n = 0 To vData.Columns.Count - 1
        Vis = IIf(vData.Columns(n).Visible, "T", "F")
        cBuf = cBuf & Format(vData.Columns(n).Width, "0.000") & ";" & Vis & ","
    Next
    cBuf = Left$(cBuf, Len(cBuf) - 1)
    ProfileSaveItem "WIDTHS", AppSet, cBuf, mvarIniFile

End Sub

'-----------------------------------------------------------
' Procedure : ProfileSaveSection
' PURPOSE   : This function saves an array of passed values to the file,
'             under the section and key names specified.
'-----------------------------------------------------------

Private Sub ProfileSaveItem(SectionName As String, _
                            KeyName As String, _
                            Value As String, _
                            IniFile As String)

    Call WritePrivateProfileString(SectionName, _
                                   KeyName, _
                                   Value, _
                                   IniFile)

End Sub

'---------------------------------------------------------------------------------------
' Procedure : ProfileGetItem
' Purpose   : Retrieves a value from an ini file corresponding
'             to the section and key name passed.
'---------------------------------------------------------------------------------------

Private Function ProfileGetItem(SectionName As String, _
                                KeyName As String, _
                                IniFile As String, _
                                Optional DefaultValue As String = "") As String


    Dim Success                     As Long
    Dim nSize                       As Long
    Dim Ret                         As String

    'call the API with the parameters passed.
    'The return value is the length of the string
    'in ret, including the terminating null. If a
    'default value was passed, and the section or
    'key name are not in the file, that value is
    'returned. If no default value was passed (""),
    'then success will = 0 if not found.

    'Pad a string large enough to hold the data.
    Ret = Space$(2048)
    nSize = Len(Ret)
    Success = GetPrivateProfileString(SectionName, _
                                      KeyName, _
                                      DefaultValue, _
                                      Ret, _
                                      nSize, _
                                      IniFile)

    If Success > 0 Then
        ProfileGetItem = Left$(Ret, Success)
    Else
        ProfileGetItem = ""
    End If

End Function


'-----------------------------------------------------------
' Procedure : Class_Initialize
'-----------------------------------------------------------
'
Private Sub Class_Initialize()
    Set mvarGrid = Nothing
End Sub

and you use it like this

Code:

[COLOR=black cyan]' General Declarations Section[/color]
Dim cwMyGrid As ColWidths


Private Sub Form_Load()
Set cwMyGrid = New ColWidths
cwMyGrid.FormName = Me.Name
cwMyGrid.IniFile = App.Path & "\AppName.INI"
Set cwMyGrid.Grid = myGrid

[COLOR=black cyan]' Code to populate the Grid[/color]

cwMyGrid.GetWidths
End Sub

Private Sub myGrid.Colresize()
cwMyGrid.SetWidths myGrid
End Sub

tazuk · Dec 26, 2006

Excellent posts there Golom

A star and a virtual pint to you [cheers]

TazUk

Programmer An organism that turns coffee into software. [morning]

Unknown Author

dabineri · Dec 26, 2006

Golom, You have been more than generous with your posts but I still need a few hints.

1. The RESIZE event is executed many times as one drags out the form size. Where is the best place to reset the grid column sizes. It doesn't seem like a good idea to refresh the grid until the resizing is complete, otherwise it might be very slow at resizing if it were to be done every time the resize method is called.

2. Should I use the GetSetting and SaveSetting to remember the last size set for the form and grid?

Thanks again for your excellent posts!

David Abineri

Golom · Dec 27, 2006

There's a bit of a conflict between resize and setting the column widths.

What I mean by that is that the above column width code saves and sets column widths in absolute terms. That is, it does not establish them in proportion to overall form size. You will notice that column widths that are appropriate at one screen size are not (or may not be) appropriate when you resize the screen.

You could amend the code to save and restore column widths in some proportional units that adjust for screen size although that could make for some complex interactions between the column widths that you set and the font sizes that are being set by the form resize code.

As a practical matter I don't reset the column widths when I resize the screen. I do it only when I initially load data into the grid or when I Requery or Refresh the grid.

The ColWidths code doesn't save the size of the form or the size of the grid. It saves only the column widths and their hidden status. I can visualize the modifications necessary to incorporate those features but my own applications don't require that kind of elaboration and, as you noted, the penalty associated with doing all this within a form resize would probably be unacceptable.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

RESIZING ALL CONTENTS OF A WINDOW? 13

Programmer

Programmer

Programmer

Programmer

Programmer

MIS

Instructor

MIS

Programmer

Programmer

MIS

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Programmer

Similar threads

Log in

Part and Inventory Search

Sponsor