[AccessD] Form Controls - Class implementation two - clsCtlsSorted2

OK for the "scan the controls once" issue the classes end up looking much the same, with the 
scanning moved entirely out of the clsCtlsSorted.

'
'clsCtlsSorted2
'
Option Compare Database
Option Explicit

Private mstrObjName As String
Private mcolCtlsSorted As Collection

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

Private Sub Class_Terminate()
     Set mcolCtlsSorted = Nothing
End Sub
'
'Pass in any collection of controls to be stored in sorted order
'
Function mInit(lstrObjName As String)
     mstrObjName = lstrObjName
End Function
Property Get pObjName() As String
     pObjName = mstrObjName
End Property
'
'Return the collection of controls in sorted order (keyed on TabIndex)
'
Property Get pCtlsSorted() As Collection
     Set pCtlsSorted = mcolCtlsSorted
End Property
'
'Iterate the collection of controls getting each control name
'and appending it to a string
'
'---------------------------------------------------------------------------------------
' Procedure : pCtlNames
' Author    : jwcolby
' Date      : 10/27/2009
' Purpose   :
'---------------------------------------------------------------------------------------
'
Property Get pCtlNames() As String
Dim ctl As Control
Dim strCtlNames As String

Dim intIndex As Integer

On Error GoTo Err_pCtlNames

     strCtlNames = pObjName & ":: " & vbCrLf
     For Each ctl In mcolCtlsSorted
         strCtlNames = strCtlNames & vbTab & ctl.Name
     Next ctl
     pCtlNames = strCtlNames

Exit_pCtlNames:
     On Error Resume Next
     Exit Property
Err_pCtlNames:
     Select Case Err
     Case 0      '.insert Errors you wish to ignore here
         Resume Next
     Case Else   '.All other errors will trap
         Beep
         MsgBox Err.Number & ":" & Err.Description
         Resume Exit_pCtlNames
     End Select
     Resume 0    '.FOR TROUBLESHOOTING
End Property

Function mAddCtl(ctl As Control)
On Error Resume Next
     mcolCtlsSorted.Add ctl, CStr(ctl.TabIndex)
End Function
'
'Sorts the controls in mcolCtlsSorted into sorted order
'
'---------------------------------------------------------------------------------------
' Procedure : mSortcontrols
' Author    : jwcolby
' Date      : 10/27/2009
' Purpose   :
'---------------------------------------------------------------------------------------
'
Function mSortcontrols()
Dim ctl As Control
Dim intIndex As Integer
Dim col As Collection
On Error GoTo Err_mSortcontrols

     Set col = New Collection
     With mcolCtlsSorted
         If .Count Then  'Check that there are controls in mcolCtlsSorted
             For intIndex = 0 To .Count - 1      'Iterate through mcolCtlsSorted
                 col.Add .Item(CStr(intIndex))   'Copying the controls into the temp collection
             Next intIndex
         End If
     End With
     '
     'If there are any controls in the temp collection then
     'set the main collection to the temp collection
     If col.Count Then
         Set mcolCtlsSorted = col
     End If

Exit_mSortcontrols:
     On Error Resume Next
     Exit Function
Err_mSortcontrols:
     Select Case Err
     Case 0      '.insert Errors you wish to ignore here
         Resume Next
     Case Else   '.All other errors will trap
         Beep
         MsgBox Err.Number & ":" & Err.Description
         Resume Exit_mSortcontrols
     End Select
     Resume 0    '.FOR TROUBLESHOOTING
End Function




John W. Colby
www.ColbyConsulting.com


A.D.Tejpal wrote:
> JC,
> 
>     Thanks for providing a nice class based solution so promptly. Your well 
> known command over classes deserves to be complimented.