CY Databases

The Zoom Form Proof-of-Concept Application

Good Morning or perhaps afternoon,
Thank you for dropping by. Please look at the application page. Download a copy of the application if you like. Please send me feedback about the methods used. This is a proof-of-concept piece. It is not designed to be a free-standing application there are rough edges.

Disclaimer:

This code is presented as is where is with no guarentee stated or implied.
The code was developed to run in a Win10/Office 365 environment. It is designed to run without making changes to your computer.
The author, Carl F. Yos, is not responsible for its performance in your environment.
Use this application at your own risk.
The author, Carl F Yos, is not responsible for any damage caused by this application.

Using the Proof-of-Ccncept App:

The application opens to test form.

Click the enable content button for the code to run.

In the upper right hand corner of the test form is a spinner and a text box.

Clicking the spinner up and down with the mouse or entering a value of 0 - 9 in the textbox followed by the enter key triggers the resizing action.

The application has been left in development format ACCDB. The code is readily available for inspection.

Download Notes

The file is avaialable in two formats. The first link is the ACCDB version of the file. This can be copied to a folder on your computer and run. No installation is needed.

Some browsers and anti-virus software take exception to ACCDB files. A Zip format file is available. The file will need to be extracted to a folder on your computer in order to run.

Download the File


Download the ACCDB version here.



Download the Zip version here.

Zoom Form Proof-of-Concept Notes

More detail about the logic and structure of the application

The Story

On my first MS Access gig, I had this great idea. A database to generate and store passwords both for work and for home. I called it Password Manager. I use it at home, and I have carried a copy of it to every contract. After more than 20 years I still use Password Manager mulitple times every day.

Lately I have been noticing a growing problem that many of my fellow MS Access users share. A 12-point font is becoming hard to read. An 8-point font is positively microscopic. And a 6-point is invisible. I find myself copying more and more data from MS Access to some other application that allows magnification. Something had to be done.

I needed a simple means to reliably resize any form and its controls and fonts. It should be a simple process to update existing forms.

The Concept

I want to thank Ramachandran Pillai for his work on classes. It got me to thinking along those lines. I realized the information for a baseline size could be held in an instance of a recursive collection class. The form and its controls could be resized relative to their baseline and not to their current size and position which would eliminate many of the problems I had found with other methods.

All of the size data is available as integers from VBA. Well this is Microsoft. Almost all. Multicolumn list and combo box column width data is kept in a string format that must be parced and converted. When a form is in datasheet view, the datasheet row height is a property of the form. Each text control in datasheet view has a column width property which is inherited from the source table of the data.

Name, Width, Height, Left, Right, Font Size or 6 variables are all that are needed to hold the size and postion data for any object on a form.

Methods

The basic data structure used is the node / child node relationship. The form is the top node. It contains a collection of sections. Each section contains a collection of controls. If the control is a multi-column list or combo box, the control contains a collection of columns. If the control is a subform then it contains a collection of a form and all of the sub nodes described above. If the control is a tab control then the section controls collection contains all of the controls on the tabs. The tabs are members of the section control collection. No special handling is needed for tab controls. The single class ClassFormSize can capture the size, position, and relationship of controls on a form of any complexity.

The Microsoft split form has not been addressed

The data structure can be expressed as an ordinary outline format.

  1. The form (Top node no parent)
    1. Section (Child node of parent form)
      1. Control (child node of parent section)
        1. Column (child node of parent control)
        2. SubForm (child node of parent control)
          1. SubForm children...

The secret sause (The ClassFormSize Class)

The class is a simple structure.

Click to Expand

Option Compare Database
Option Explicit

Private pObjSizeCollection As New Collection

Private pObjName As String
Private pObjWidth As Integer
Private pObjHeight As Integer
Private pObjTop As Integer
Private pObjLeft As Integer
Private pObjFontSize As Integer

'Private pObjName As String
Public Property Get ObjName() As String
   ObjName = pObjName
End Property
Public Property Let ObjName(Value As String)
   pObjName = Value
End Property

'Private pObjWidth As integer
Public Property Get ObjWidth() As Integer
   ObjWidth = pObjWidth
End Property
Public Property Let ObjWidth(Value As Integer)
   pObjWidth = Value
End Property

'Private pObjHeight As integer
Public Property Get ObjHeight() As Integer
   ObjHeight = pObjHeight
End Property
Public Property Let ObjHeight(Value As Integer)
   pObjHeight = Value
End Property

'Private pObjTop As integer
Public Property Get ObjTop() As Integer
   ObjTop = pObjTop
End Property
Public Property Let ObjTop(Value As Integer)
   pObjTop = Value
End Property

'Private pObjLeft As integer
Public Property Get ObjLeft() As Integer
   ObjLeft = pObjLeft
End Property
Public Property Let ObjLeft(Value As Integer)
   pObjLeft = Value
End Property

'Private pObjFontSize As integer
Public Property Get ObjFontSize() As Integer
   ObjFontSize = pObjFontSize
End Property
Public Property Let ObjFontSize(Value As Integer)
   pObjFontSize = Value
End Property

Public Property Get ObjExist(IndexOrKey As Variant) As Boolean
Dim clFormSize As ClassFormSize
Dim strKey As String
Dim lngIndex As Integer

On Error GoTo Error_ObjExist
ObjExist = False
If IsNumeric(IndexOrKey) Then
	lngIndex = CLng(IndexOrKey)						
	If lngIndex > 0 And lngIndex <= pObjSizeCollection.Count Then
		ObjExist = True
	End If
Else
	strKey = CStr(IndexOrKey)
	Set clFormSize = pObjSizeCollection.Item(strKey)
	ObjExist = True
End If

Exit_ObjExist:
If Not clFormSize Is Nothing Then
	Set clFormSize = Nothing
End If
Exit Property
Error_ObjExist:
ObjExist = False
Resume Exit_ObjExist
End Property

Public Property Get ObjCount() As Integer
	ObjCount = pObjSizeCollection.Count
End Property

Public Sub sAddObject(clNew As ClassFormSize)
Dim strKey As String
strKey = clNew.ObjName
If Not ObjExist(strKey) Then
 pObjSizeCollection.Add clNew, strKey
End If
End Sub

Public Property Get GetObj(IndexOrKey As Variant) As ClassFormSize
Dim strKey As String
Dim lngIndex As Integer

If ObjExist(IndexOrKey) Then
	If IsNumeric(IndexOrKey) Then
		lngIndex = CLng(IndexOrKey)
		Set GetObj = pObjSizeCollection.Item(lngIndex)
	Else
		strKey = CStr(IndexOrKey)
		Set GetObj = pObjSizeCollection.Item(strKey)
	End If
End If
End Property

The hard working module (The ModResizeForm Module)

The module contians two sub routines and two functions.

Dim Cntl As Control
Dim SubCntl As Control
Dim subFrm As Form

Dim clColumn As ClassFormSize
Dim clDataSheet As ClassFormSize
Dim clSection As ClassFormSize
Dim clControl As New ClassFormSize
Dim clSubForm As New ClassFormSize

Dim strSub As String
Dim intLoop As Integer
Dim intColCount As Integer
Dim strColWidths As String
Dim intCol As Integer
Dim varColList As Variant
Dim dblColWidth As Double
Dim intColWidth As Integer
Dim strCol As String
Dim intWindowHeight As Integer
Dim intWindowWidth As Integer

' Determine form's width.
intWindowHeight = frm.InsideHeight
intWindowWidth = frm.InsideWidth

'set the default values for the form
clTopForm.ObjHeight = intWindowHeight
clTopForm.ObjWidth = intWindowWidth
clTopForm.ObjName = frm.Name


'If the form is in datasheet view then do something exciting.
If frm.CurrentView = 2 Then
    Set clDataSheet = New ClassFormSize
    'Font size.
    clDataSheet.ObjFontSize = frm.DatasheetFontHeight
    'Row height.
    clDataSheet.ObjHeight = frm.RowHeight
    'list control names in detail section.
    Set clSection = New ClassFormSize
    clSection.ObjName = frm.Section(0).Name
    
    For Each Cntl In frm.Section(0).Controls
        Set clControl = New ClassFormSize
        clControl.ObjName = Cntl.Name
        clSection.sAddObject clControl
        Set clControl = Nothing
    Next
    clDataSheet.sAddObject clSection
    Set clSection = Nothing
    clTopForm.sAddObject clDataSheet
    Set clDataSheet = Nothing
    
Else
     
     'Loop through the sections and controls.
    intLoop = 0
    Do
        'section.
        If fHasSection(frm, intLoop) Then
            Set clSection = New ClassFormSize
            clSection.ObjName = frm.Section(intLoop).Name
            clSection.ObjHeight = frm.Section(intLoop).Height
            'controls.
            For Each Cntl In frm.Section(intLoop).Controls
                Set clControl = New ClassFormSize
                clControl.ObjName = Cntl.Name
                clControl.ObjWidth = Cntl.Width
                clControl.ObjHeight = Cntl.Height
                clControl.ObjTop = Cntl.Top
                clControl.ObjLeft = Cntl.Left
                If fHasFontSize(Cntl) Then
                    clControl.ObjFontSize = Cntl.FontSize
                Else
                    clControl.ObjFontSize = 0
                End If
                Select Case Cntl.ControlType
                    Case acSubform
                        'Get the subform
                        Set clSubForm = New ClassFormSize
                        '[Forms]![frmPassword]![tblSecureQuestion].[form]![SecureQuestion].
                        Set subFrm = Cntl.Form
                        sReadDefaultSize subFrm, clSubForm
                        clControl.sAddObject clSubForm
                        Set clSubForm = Nothing
                        Set subFrm = Nothing
                    Case acListBox, acComboBox
                        'get the columns.
                        intColCount = Cntl.ColumnCount
                        If intColCount = 1 Then
                            Set clColumn = New ClassFormSize
                            clColumn.ObjName = "Col_0"
                            clColumn.ObjWidth = Cntl.ColumnWidth
                            clControl.sAddObject clColumn
                            Set clColumn = Nothing
                        Else
                            strColWidths = Cntl.ColumnWidths
                            varColList = Split(strColWidths, ";")
                            For intCol = 0 To intColCount - 1
                                strCol = varColList(intCol)
                                If InStr(1, strCol, "in") > 0 Then
                                    dblColWidth = CDbl(Trim(Left(strCol, InStr(1, strCol, "in"))))
                                    intColWidth = CInt(dblColWidth * 1440)
                                ElseIf InStr(1, strCol, "cm") > 0 Then
                                    dblColWidth = CDbl(Trim(Left(strCol, InStr(1, strCol, "cm"))))
                                    intColWidth = CInt(dblColWidth * 567)
                                Else
                                    intColWidth = CInt(Trim(strCol))
                                End If
                                Set clColumn = New ClassFormSize
                                clColumn.ObjName = "Col_" & intCol
                                clColumn.ObjWidth = intColWidth
                                clControl.sAddObject clColumn
                                Set clColumn = Nothing
                            Next
                        End If
                End Select
                
                clSection.sAddObject clControl
                Set clControl = Nothing
            Next
            clTopForm.sAddObject clSection
            Set clSection = Nothing
            'print the height.
            'Debug.Print clTopForm.GetObj("Detail").ObjHeight.
        End If
        intLoop = intLoop + 1
        If intLoop = 3 Then Exit Do
    Loop
End If
'Debug.Print "Loaded".
End Sub


Select Case Cntl.ControlType
    Case acComboBox, acCommandButton, acLabel, acListBox, acTextBox
        fHasFontSize = True
    Case Else
        fHasFontSize = False
End Select
End Function

Dim bolTest As Boolean

On Error GoTo Error_fHasSection
bolTest = frm.Section(intSection).Visible
fHasSection = True

Exit_fHasSection:
Exit Function

Error_fHasSection:
fHasSection = False
Resume Exit_fHasSection
End Function

Dim Cntl As Control
Dim subFrm As Form

Dim clColumn As ClassFormSize
Dim clDataSheet As ClassFormSize
Dim clSection As ClassFormSize
Dim clControl As ClassFormSize

Dim intSpin As Integer
Dim dblDelta As Double

Dim intCol As Integer, intColCount As Integer
Dim strColWidths As String
Dim intColWidth As Integer
Dim intColWidthNew As Integer

Dim intWidthDefault As Integer
Dim intHeightDefault As Integer
Dim intLeftDefault As Integer
Dim intTopDefault As Integer
Dim intFontSizeDefault As Integer

Dim intWidthNew As Integer
Dim intHeightNew As Integer
Dim intLeftNew As Integer
Dim intTopNew As Integer
Dim intFontSizeNew As Integer

Dim intLoop As Integer, intLoopMax As Integer
Dim strSection As String
Dim strControl As String
Dim strColumn As String
Dim lngIndex As Long, lngIndexMax As Long


'Get the change
intSpin = SpinValue
dblDelta = 1 + (intSpin / 10)

'calculate the new form width and height
intWidthDefault = clTopForm.ObjWidth
intHeightDefault = clTopForm.ObjHeight

intWidthNew = CInt(CDbl(intWidthDefault) * dblDelta)
intHeightNew = CInt(CDbl(intHeightDefault) * dblDelta)

'Set the new form width and height
frm.InsideWidth = intWidthNew
frm.InsideHeight = intHeightNew


If frm.CurrentView = 2 Then
   Set clDataSheet = clTopForm.GetObj(1)
   'set font size
   intHeightNew = CInt(CDbl(clDataSheet.ObjFontSize) * dblDelta)
   frm.DatasheetFontHeight = intHeightNew
   'set row height
   intHeightNew = CInt(CDbl(clDataSheet.ObjHeight) * dblDelta)
   frm.RowHeight = intHeightNew
   'set each column to the width of the text
   Set clSection = clDataSheet.GetObj(1)
  'columns
   lngIndexMax = clSection.ObjCount
   For lngIndex = 1 To lngIndexMax
       Set clColumn = clSection.GetObj(lngIndex)
       strColumn = clColumn.ObjName
       Set Cntl = frm.Section(0).Controls(strColumn)
       Cntl.ColumnWidth = -2
       Set clColumn = Nothing
   Next
   Set clSection = Nothing
   Set clDataSheet = Nothing
Else

'Set the sections
    intLoopMax = clTopForm.ObjCount
    For intLoop = 1 To intLoopMax
        'set new
        Set clSection = clTopForm.GetObj(intLoop)
        strSection = clSection.ObjName
        intHeightDefault = clSection.ObjHeight
        intHeightNew = CInt(CDbl(intHeightDefault) * dblDelta)
        frm.Section(strSection).Height = intHeightNew
        'controls
        lngIndexMax = clSection.ObjCount
        For lngIndex = 1 To lngIndexMax
            Set clControl = clSection.GetObj(lngIndex)
            strControl = clControl.ObjName
            'get the default values
            intWidthDefault = clControl.ObjWidth
            intHeightDefault = clControl.ObjHeight
            intLeftDefault = clControl.ObjLeft
            intTopDefault = clControl.ObjTop
            intFontSizeDefault = clControl.ObjFontSize
            
            'Calculate the new values
            intWidthNew = CInt(CDbl(intWidthDefault) * dblDelta)
            intHeightNew = CInt(CDbl(intHeightDefault) * dblDelta)
            intLeftNew = CInt(CDbl(intLeftDefault) * dblDelta)
            intTopNew = CInt(CDbl(intTopDefault) * dblDelta)
            intFontSizeNew = CInt(CDbl(intFontSizeDefault) * dblDelta)
            
            'resize the control
            Set Cntl = frm.Section(strSection).Controls(strControl)
            
            Cntl.Width = intWidthNew
            Cntl.Height = intHeightNew
            Cntl.Top = intTopNew
            Cntl.Left = intLeftNew
            If intFontSizeNew > 0 Then
                Cntl.FontSize = intFontSizeNew
            End If
            Select Case Cntl.ControlType
                Case acSubform
                    Dim clSubForm As ClassFormSize
                    Set clSubForm = clControl.GetObj(1)
                    Set subFrm = Cntl.Form
                    sResizeForm subFrm, clSubForm, intSpin
                    Set clSubForm = Nothing
                    Set subFrm = Nothing
                
                Case acListBox, acComboBox
                    'set the columns
                    intColCount = clControl.ObjCount
                    If intColCount = 1 Then
                        Set clColumn = clControl.GetObj(1)
                        intColWidth = clColumn.ObjWidth
                        Cntl.ColumnWidth = intColWidth
                        Set clColumn = Nothing
                    Else
                        For intCol = 1 To intColCount
                            Set clColumn = clControl.GetObj(intCol)
                            intColWidth = clColumn.ObjWidth
                            intColWidthNew = CInt(CDbl(intColWidth) * dblDelta)
                            If strColWidths = "" Then
                                strColWidths = intColWidthNew
                            Else
                                strColWidths = strColWidths ";" intColWidthNew
                            End If
                            Set clColumn = Nothing
                        Next
                        Cntl.ColumnWidths = strColWidths
                    End If
            End Select
            
            Set clControl = Nothing
    
        Next
        Set clSection = Nothing
    Next
End If
End Sub

Implementation

Required Changes to use the resizing method.

  1. Additions to the application
    1. Import two program level objects from ZoomForm4 into the application to be modified.
      1. The class "ClassFormSize"
      2. The module "ModResizeForm"

    Note: only the top forms need to be modified. Subforms will be automatically resize with the main form.

  2. Additions to the Form
    1. Add Spinner Control and a textbox to the upper left-hand corner of the header.
      1. Name them SpinSize and TxtSize respectively.
        1. These can be copied from one form to the next without editing.
    2. Add one module level variable to the top of the module behind the form.
      1. Dim clTopForm As ClassFormSize

    3. In the Form_Load event add the line.
      1. sReadDefaultSize Me, clTopForm

    4. In the SpinSize_Updated event add the lines.
      1. Me.TxtSize = SpinSize.Value
      2. sResizeForm Me, clTopForm, SpinSize.Value

    5. f. In the TxtSize_AfterUpdate event add the lines.
      1. Me.SpinSize.Value = Me.TxtSize
      2. sResizeForm Me, clTopForm, SpinSize.Value

Some Controls of Note on the Form

Most of the controls are not functional. The sole purpose of the form is to show resizing of a variety of control types and form structures.
The ones of interest are in the header and the close button in the footer. See below.

FormWithLabels
Return to Home Page

Copyright © 2021 CYDatabases