[AccessD] The classes as they are at this instant - clsFrm

jwcolby jwcolby at colbyconsulting.com
Wed Feb 11 11:10:15 CST 2009


Option Compare Database
Option Explicit

Private WithEvents mfrm As Form
Private Const cstrEvProc As String = "[Event Procedure]"

Private colCtls As Collection

Private Sub Class_Initialize()
      Set colCtls = New Collection
End Sub

Private Sub Class_Terminate()
      Set colCtls = Nothing
End Sub

Function mInit(lfrm As Form)
     Set mfrm = lfrm
     mfrm.BeforeUpdate = cstrEvProc
     mfrm.OnClose = cstrEvProc
     CtlScanner
End Function

Private Sub mfrm_BeforeUpdate(Cancel As Integer)
     MsgBox "Before Update: " & mfrm.Name
End Sub
Private Sub mfrm_Close()
     Set mfrm = Nothing
End Sub

Private Function CtlScanner()
Dim ctl As Control
     For Each ctl In mfrm.Controls
         Select Case ctl.ControlType
             Case acCheckBox
             Case acComboBox
                 Dim lclsCtlCbo As clsCtlCbo
                 Set lclsCtlCbo = New clsCtlCbo
                 lclsCtlCbo.mInit ctl
                 colCtls.Add lclsCtlCbo, ctl.Name
             Case acCommandButton
             Case acListBox
             Case acOptionButton
             Case acOptionGroup
             Case acPage
             Case acSubform  'subform controls
             Case acTabCtl   'tab pages are handled in the tab control
             Case acTextBox  'Find all text boxes and load class to change backcolor
                 Dim lclsCtlTxt As clsCtlTxt
                 Set lclsCtlTxt = New clsCtlTxt
                 lclsCtlTxt.mInit ctl
                 colCtls.Add lclsCtlTxt, ctl.Name
             Case acToggleButton
         End Select
     Next ctl
End Function


-- 
John W. Colby
www.ColbyConsulting.com



More information about the AccessD mailing list