Simple CLS for Resizing CTLs on a FRM

SleepDepD 0 Tallied Votes 136 Views Share

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