The CForm Resizer Class

By encapsulating all the resize code in a separate class module, any UserForm can be made resizable by adding just six lines of code to instantiate and call into the class, and setting the resize behavior for each control in its Tag property.

The CFormResizer class provides the following functionality:

□ Sets the form to be resizable.

□ Sets the initial size and position of the form, if it has been shown before.

□ Resizes and repositions all the controls on the form, according to their Tag resizing string.

□ Stores the form's size and position in the registry, for use when the same form is shown again.

□ Allows the calling code to specify a key name for storing the form dimensions in the registry.

□ Prevents a form being resized in either direction if none of the controls are set to respond to changes in height or width.

□ Stops resizing when any control is moved to the left or top edge of the form, or when any control is reduced to zero height or width.

The code for the CFormResizer class is as follows, with comments in the code to explain each section. It is available for download in the FormResizer.xlsm workbook at www.wrox.com:

Option Explicit

'Find the UserForm's window handle

Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long

'Get the UserForm's window style

Private Declare Function GetWindowLong Lib "user32" _ Alias "GetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long) As Long

'Set the UserForm's window style

Private Declare Function SetWindowLong Lib "user32" _ Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long

'The offset of a window's style

Private Const GWL_STYLE As Long = (-16) 'Style to add a sizable frame

Private Const WS_THICKFRAME As Long = &H40000

Dim moForm As Object Dim mhWndForm As Long Dim mdWidth As Double Dim mdHeight As Double Dim msRegKey As String

'Default for the registry key to store the dimensions Private Sub Class_Initialize()

msRegKey = "Excel 2007 Prog Ref" End Sub

'Properties to identify where in the registry to store the UserForm 'position information

Public Property Let RegistryKey(sNew As String)

msRegKey = sNew End Property

Public Property Get RegistryKey() As String

RegistryKey = msRegKey End Property

'We're told which form to handle the resizing for, 'set in the UserForm_Initialize event.

'Make the form resizable and set its size and position Public Property Set Form(oNew As Object)

Dim sSizes As String, vaSizes As Variant Dim iStyle As Long

'Remember the form for later Set moForm = oNew

'Get the UserForm's window handle If Val(Application.Version) < 9 Then 'XL97

mhWndForm = FindWindow("ThunderXFrame", moForm.Caption)

Else

'XL2000 and 2002

mhWndForm = FindWindow("ThunderDFrame", moForm.Caption) End If

'Make the form resizable iStyle = GetWindowLong(mhWndForm, GWL_STYLE) iStyle = iStyle Or WS_THICKFRAME SetWindowLong mhWndForm, GWL_STYLE, iStyle

'Read its dimensions from the registry (if there)

'The string has the form of "<Top>;<Left>;<Height>;<Width>"

sSizes = GetSetting(msRegKey, "Forms", moForm.Name, "")

'Remember the current size for use in the Resize routine mdWidth = moForm.Width mdHeight = moForm.Height

'If we got a dimension string, split it into its parts vaSizes = Split(sSizes, ";")

'Make sure we got 4 elements! ReDim Preserve vaSizes(0 To 3)

'Set the form's size and position moForm.Top = Val(vaSizes(0)) moForm.Left = Val(vaSizes(1)) moForm.Height = Val(vaSizes(2)) moForm.Width = Val(vaSizes(3))

'Set to manual startup position moForm.StartUpPosition = 0 End If

End Property

'Called from the User_Form resize event, also triggered when 'the size ourself.

we change

'This is the routine that performs the resizing, by checking 'Tag property, and moving/sizing it accordingly. Public Sub FormResize()

each control's

Dim dWidthAdj As Double, dHeightAdj As Double Dim bSomeWidthChange As Boolean Dim bSomeHeightChange As Boolean Dim sTag As String, sSize As String Dim oCtl As MSForms.Control

Static bResizing As Boolean

'Resizing can be triggered from within this routine, 'so use a flag to prevent recursion If bResizing Then Exit Sub bResizing = True

'Calculate the change in height and width dHeightAdj = moForm.Height - mdHeight dWidthAdj = moForm.Width - mdWidth

'Check if we can perform the adjustment '(i.e. widths and heights can't be negative) For Each oCtl In moForm.Controls

'Read the control's Tag property, which contains the sTag = UCase(oCtl.Tag)

resizing info

'If we're changing the Top, check that it won't move

off the top

'of the form

If InStr(1, sTag, "T", vbBinaryCompare) Then

If oCtl.Top + dHeightAdj * ResizeFactor(sTag, "T") <= 0 Then moForm.Height = mdHeight End If bSomeHeightChange = True End If

'If we're changing the Left, check that it won't move off the 'left of the form

If InStr(1, sTag, "L", vbBinaryCompare) Then

If oCtl.Left + dWidthAdj * ResizeFactor(sTag, "L") <= 0 Then moForm.Width = mdWidth End If bSomeWidthChange = True End If

'If we're changing the Height, check that it won't go negative If InStr(1, sTag, "H", vbBinaryCompare) Then

If oCtl.Height + dHeightAdj * ResizeFactor(sTag, "H") <= 0 Then moForm.Height = mdHeight End If bSomeHeightChange = True End If

'If we're changing the Width, check that it won't go negative If InStr(1, sTag, "W", vbBinaryCompare) Then

If oCtl.Width + dWidthAdj * ResizeFactor(sTag, "W") <= 0 Then moForm.Width = mdWidth End If bSomeWidthChange = True End If Next 'Control

'If none of the controls move or size, 'don't allow the form to resize in that direction If Not bSomeHeightChange Then moForm.Height = mdHeight If Not bSomeWidthChange Then moForm.Width = mdWidth

'Recalculate the height and width changes, 'in case the previous checks reset them dHeightAdj = moForm.Height - mdHeight dWidthAdj = moForm.Width - mdWidth

'Loop through all the controls on the form, 'adjusting their position and size For Each oCtl In moForm.Controls With oCtl sTag = UCase(.Tag)

'Changing the Top

If InStr(1, sTag, "T", vbBinaryCompare) Then

.Top = .Top + dHeightAdj * ResizeFactor(sTag, "T") End If

'Changing the Left

If InStr(1, sTag, "L", vbBinaryCompare) Then

.Left = .Left + dWidthAdj * ResizeFactor(sTag, "L") End If

'Changing the Height

If InStr(1, sTag, "H", vbBinaryCompare) Then

.Height = .Height + dHeightAdj * ResizeFactor(sTag, "H") End If

'Changing the Width

If InStr(1, sTag, "W", vbBinaryCompare) Then

.Width = .Width + dWidthAdj * ResizeFactor(sTag, "W") End If End With Next 'Control

'Remember the new dimensions of the form for next time mdWidth = moForm.Width mdHeight = moForm.Height

'Store the size and position in the registry With moForm

SaveSetting msRegKey, "Forms", .Name, Str(.Top) & ";" & _

Str(.Left) & ";" & Str(.Height) & ";" & Str(.Width)

End With

'Reset the recursion flag, now that we're done bResizing = False

End Sub

'Function to locate a property letter (T, L, H or W) in the Tag string 'and return the resizing factor for it

Private Function ResizeFactor(sTag As String, sChange As String)

Dim i As Integer, d As Double

'Locate the property letter in the tag string i = InStr(1, sTag, sChange, vbBinaryCompare)

'... read the number following it d = Val(Mid$(sTag, i + 1))

'If there was no number, use a factor of 100% If d = 0 Then d = 1 End If

'Return the factor ResizeFactor = d

End Function

The code to use the CFormResizer class in a UserForm's code module is as follows:

'Declare an object for our CFormResizer class to handle

'resizing for this form

Dim moResizer As CFormResizer

'The Resizer class is set up in the UserForm_Initialize event Private Sub UserForm_Initialize()

'Create the instance of the class Set moResizer = New CFormResizer

'Tell it where to store the form dimensions moResizer.RegistryKey = "Excel 2007 Prog Ref"

'Tell it which form it's handling Set moResizer.Form = Me

End Sub

'When the form is resized, the UserForm_Resize event is raised, 'which we just pass on to the Resizer class Private Sub UserForm_Resize()

moResizer.FormResize End Sub

'The OK button unloads the form Private Sub btnOK_Click()

Unload Me End Sub

'The QueryClose event in called whenever the form is closed. 'We call the FormResize method one last time, to store the form's 'final size and position in the registry

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

moResizer.FormResize End Sub

There are a few points to remember when using this approach in your own UserForms:

□ The resizer works by changing the control's Top, Left, Height, and Width properties in response to changes in the UserForm size, according to the control's resizing information.

□ The control's resizing information is set in its Tag property, using the letters T, L, H, or W followed by a number specifying the resizing factor (if not 100%).

□ The resizing factors must be in U.S. format, using a period as the decimal separator.

□ If there are no controls that have T or H in their Tag strings, the form will not be allowed to resize vertically.

□ If there are no controls that have L or W in their Tag strings, the form will not be allowed to resize horizontally.

□ The smallest size for the form is set by the first control to be moved to the top or left edge, or to have a zero width or height.

□ This can be used to set a minimum size for the form by using a hidden label with a Tag of HW, where the size of the label equals the amount that the form can be reduced in size. If the label is set to zero height and width to start with, the UserForm can only be enlarged from its designtime size.

□ List boxes must have their IntegralHeight property set to False for this to work, but due to an old bug, they may not fully display the very last item in the list. As a workaround, add a blank entry as the last item in the list, and code to ignore it if it gets selected.

Was this article helpful?

0 0
The Accidental Blogging Millionaires

The Accidental Blogging Millionaires

Get Inspired By The Most Popular Bloggers Online! If You Want To Skyrocket Your Success With Business And Improve Your Overall Life You Need To Have A Look At The Accidental Blogging Millionaires! Business can be a fight, particularly when you’re trying to establish one online and like all fights, to succeed you must find the winning techniques and apply them.

Get My Free Ebook


Post a comment