Simple CLS for Resizing CTLs on a FRM
Simple CLS for Resizing CTLs on a FRM
'!! PLACE THE FOLLOWING ON A FRM
Option Explicit
'!! THE CLASS IS USED IN THE FOLLOWING WAY
'!! Add the following CMDs to the FRM: cmdMatchWidth, cmdMatchHeight, cmdStayBottomRight
Private mclsFRMResizer As cFRMResizer
'
Private Sub Form_Load()
'===============================================================================
'!! THE FOLLOW LINES ARE FOR THIS EXAMPLE
'-- Setup FRM
With Me
.BorderStyle = 2: .Width = 4755: .Height = 3600
End With
'-- Setup CMDs
With Me.cmdMatchWidth
.Left = 60: .Top = 60: .Width = 4515: .Height = 495
End With
With Me.cmdMatchHeight
.Left = 60: .Top = 600: .Width = 1455: .Height = 2535
End With
With Me.cmdStayBottomRight
.Left = 3120: .Top = 2640: .Width = 1455: .Height = 495
End With
'-- Initialize and setup 'CFRMResizer'
Set mclsFRMResizer = New cFRMResizer
Call mclsFRMResizer.Setup(Me)
With mclsFRMResizer
' ex.: .AddCTL [enuFRMResizeType_X], [enuFRMResizeType_Y}
.AddCTL Me.cmdMatchWidth, ertGrow
.AddCTL Me.cmdMatchHeight, , ertGrow
.AddCTL Me.cmdStayBottomRight, ertMove, ertMove
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
'===============================================================================
Set mclsFRMResizer = Nothing
End Sub
'!! PLACE THE FOLLOWING IN A MODULE
Option Explicit
'-- The following is used in 'CFRMResizer'
Public Enum enuFRMResizeTypes
ertGrow = 1 '-- CTL's height/width should increase
ertMove '-- CTL's top/left should increase
End Enum
'!! PLACE THE FOLLOWING IN A CLASS MODULE WITH THE NAME 'cFRMResizer'
Option Explicit
Private Type typResizeCTL
ctl As Control
'-- Defines the X and Y behavior at resize time
' (height/top or width/left increased)
enuFRMResizeType_X As enuFRMResizeTypes
enuFRMResizeType_Y As enuFRMResizeTypes
'-- Used internally for determining new height/top or width/left
lngOrigCTL_X As Long
lngOrigCTL_Y As Long
End Type
Private matypResizeCTLs() As typResizeCTL
Private mintUBound As Integer
Private mlngOrigFRMHeight As Long
Private mlngOrigFRMWidth As Long
Private WithEvents mfrm As Form
'
Private Sub Class_Initialize()
'===============================================================================
ReDim matypResizeCTLs(0)
End Sub
Private Sub Class_Terminate()
'===============================================================================
Erase matypResizeCTLs()
Set mfrm = Nothing
End Sub
Public Sub Setup(frm As Form)
'===============================================================================
Set mfrm = frm
'-- Store original FRM height and width
With mfrm
mlngOrigFRMHeight = .Height
mlngOrigFRMWidth = .Width
End With
End Sub
Public Sub AddCTL(ctl As Control, Optional enuFRMResizeType_X As enuFRMResizeTypes _
, Optional enuFRMResizeType_Y As enuFRMResizeTypes)
'===============================================================================
'-- If there aren't any elements
If Not (mintUBound = 0 And matypResizeCTLs(0).ctl Is Nothing) Then
'-- Increase array
mintUBound = mintUBound + 1
ReDim Preserve matypResizeCTLs(mintUBound)
End If
With matypResizeCTLs(mintUBound)
Set .ctl = ctl
'-- Store "X" resize type and determine which "X" value to store in lngOrigCTL_X
.enuFRMResizeType_X = enuFRMResizeType_X
Select Case enuFRMResizeType_X
Case ertGrow: .lngOrigCTL_X = ctl.Width
Case ertMove: .lngOrigCTL_X = ctl.Left
End Select
'-- Store "Y" resize type and determine which "Y" value to store in lngOrigCTL_Y
.enuFRMResizeType_Y = enuFRMResizeType_Y
Select Case enuFRMResizeType_Y
Case ertGrow: .lngOrigCTL_Y = ctl.Height
Case ertMove: .lngOrigCTL_Y = ctl.Top
End Select
End With
End Sub
Private Sub mfrm_Resize()
'===============================================================================
Dim lngCounter As Long
Dim lngFRMHeight As Long
Dim lngFRMWidth As Long
Dim lngNewValue As Long
'-- Make sure height and width are not less than the original
With mfrm
If .Height < mlngOrigFRMHeight Then .Height = mlngOrigFRMHeight
If .Width < mlngOrigFRMWidth Then .Width = mlngOrigFRMWidth
lngFRMHeight = .Height
lngFRMWidth = .Width
End With
For lngCounter = 0 To mintUBound
With matypResizeCTLs(lngCounter)
'-- If a resize type was saved for this CTL's "X"
If .enuFRMResizeType_X > 0 Then
'-- Get new value from mlngOrigFRMWidth and CTL's lngOrigCTL_X
lngNewValue = lngFRMWidth - (mlngOrigFRMWidth - .lngOrigCTL_X)
Select Case .enuFRMResizeType_X
Case ertGrow: .ctl.Width = lngNewValue
Case ertMove: .ctl.Left = lngNewValue
End Select
End If
'-- If a resize type was saved for this CTL's "Y"
If .enuFRMResizeType_Y > 0 Then
'-- Get new value from mlngOrigFRMHeight and CTL's .lngOrigCTL_Y
lngNewValue = lngFRMHeight - (mlngOrigFRMHeight - .lngOrigCTL_Y)
Select Case .enuFRMResizeType_Y
Case ertGrow: .ctl.Height = lngNewValue
Case ertMove: .ctl.Top = lngNewValue
End Select
End If
End With
Next lngCounter
End Sub
Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.