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!

Register Log in
  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

RESIZING ALL CONTENTS OF A WINDOW? 13

Status
Not open for further replies.
dabineri

dabineri

Programmer
Jun 20, 2001
265
0
0
US
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


 
Sort by date Sort by votes
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.
 
Upvote 0 Downvote
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


 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
Thank you again for your very clear and complete answers!

David Abineri


 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Well, I'll hang a star on that. Harebrain forgot. ;-) Golom, very useful piece of code. I'm archiving, and thanks for sharing.

Bob
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
I was going along good till I got to the bottom.
What is a 'HEAD FONT'?
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
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


 
Upvote 0 Downvote
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


 
Upvote 0 Downvote
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
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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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


 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

2009luca
  • Locked
  • Question
COUNT all items in trteeview in last level 1
Replies
4
Views
133
2009luca
2009luca
sal21
  • Locked
  • Question
NEVER used - get all possible info by ip
Replies
4
Views
92
strongm
strongm
2009luca
  • Locked
  • Question
CHECK color of shape 2
Replies
5
Views
106
strongm
strongm
2009luca
  • Locked
  • Question
population of italy live/real time
Replies
11
Views
133
strongm
strongm
sal21
  • Locked
  • Question
list all printer
Replies
1
Views
50
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top