[AccessD] Filters - was filtered reports

The clsFilters supervisor is a class that holds a collection of clsFltr.  In
essence we build a collection, code to initialize the collection and tear it
down, and a pair of properties to get the collection itself, and an item in
the collection (a clsFltr instance).

'###########################################################################
Option Compare Database
Option Explicit
'
'A collection to hold instances of clsFltr
'
Private mcolClsFltr As Collection

'
'An Initialize function to set the collection
'
Private Sub Class_Initialize()
    Set mcolClsFltr = New Collection
End Sub
'
'A terminate function to clean up
'
Private Sub Class_Terminate()
    Set mcolClsFltr = Nothing
End Sub

'
'A property to get a pointer top the collection of clsFltr(s)
'
Public Property Get pcolClsFltr() As Collection
    Set pcolClsFltr = mcolClsFltr
End Property

'
'A function to instantiate a clsFltr and store it in the collection keyed on
strClsFltrName
'If an instance already exists by that name, just get that instance out of
the collection
'
Function cClsFltr(strClsFltrName As String) As clsFltr
Dim intCnt As Integer
On Error Resume Next
Dim lclsfltr As clsFltr
    '
    'This line is used to test if the class is initialized yet
    'You will get an error if the class is not initialized
    '
    Set lclsfltr = mcolClsFltr(strClsFltrName)
    If Err <> 0 Then
        '
        'If you get an error, then initialize the class
        '
        Set lclsfltr = New clsFltr
        mcolClsFltr.Add lclsfltr, strClsFltrName
    End If
    '
    'Now we know that we have a valid class, get the pointer to it
    '
    Set cClsFltr = lclsfltr
End Function
'###########################################################################
'
'A test function to demonstrate creating a set instance and setting a filter
value in it
'
Function TestClsFltrSupervisor()
    '
    'Set up a fltr class called "fltrSetCompanyInfo" and put data in the
filter
    '
    cFS.cClsFltr("FltrSetCompanyInfo").Fltr "MyName", "John W. Colby"
    cFS.cClsFltr("FltrSetCompanyInfo").Fltr "MyCompany", "Colby Consulting"
    
    Debug.Print cFS.cClsFltr("FltrSetCompanyInfo").Fltr("MyName")
    Debug.Print cFS.cClsFltr("FltrSetCompanyInfo").Fltr("MyCompany")
    
    'Set up a different filter set called "FltrSetTaxInfo" and put data in
the filter

    cFS.cClsFltr("FltrSetTaxInfo").Fltr "MySSN", "123-45-6789"
    cFS.cClsFltr("FltrSetTaxInfo").Fltr "IncorpDate", #1/1/1950#
    
    Debug.Print cFS.cClsFltr("FltrSetTaxInfo").Fltr("MySSN")
    Debug.Print cFS.cClsFltr("FltrSetTaxInfo").Fltr("IncorpDate")
End Function

'
'A wrapper for the filter set class if needed.
'In this case we have to pass in the name of the filter set (filter class
instance)
'as well as the standard values for the filter name and value
'
Function FltrWrapper2(lstrFltrSetName As String, lstrName As String,
Optional lvarValue As Variant) As Variant
    If IsMissing(lvarValue) Then
        FltrWrapper2 = cFS.cClsFltr(lstrFltrSetName).Fltr(lstrName)
    Else
        cFS.cClsFltr(lstrFltrSetName).Fltr lstrName, lvarValue
    End If
End Function

'
'A test function to demonstrate the wrapper function
'
Function TestFltrWrapper2()
    FltrWrapper2 "SomeFltrSet", "MyAddr", "123 Programmer Way"
    Debug.Print FltrWrapper2("SomeFltrSet", "MyAddr")
End Function

'###########################################################################

As you can see, we now have a supervisor function that can be called to set
up a clsFltr class instance, and return a pointer to that class instance -
or an existing class instance.  We then simply do the same thing we did
before but now have to pass in the name of the class instance as well as the
filter data.

Again, this adds a level of complexity and makes the code more difficult to
read but it isn't overly difficult.

John W. Colby
www.ColbyConsulting.com 

Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/