Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/vbof/vbofomgr.cls

Text File | 1996-11-20 | 68.6 KB | 2,095 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VBOFObjectManager"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Option Explicit

' VB Object Framework
'   Version 1.0a
'
' (c) Copyright 1995 Ken Fitzpatrick
'     All Rights Reserved
'     Cannot be distributed or sold without permission
'
' Please refer to the attached User's Guide in file
'   "VBOF.doc" for important infomation.
'   Microsoft Word v.6.0 (or later) or equivalent
'   viewer is required.
'
' The VB Object Framework and this demonstration
'   package are provided on an as-is,
'   use-at-your-own-risk basis.
' Even though thorough testing has been performed
'   on this product and demonstration package and
'   every resonable precaution has been taken, the
'   author assumes no responsibilities of any
'   actions or damages which result from the use of
'   this product or demonstration package.
' The above statement is necessary because the very
'   nature of VB Object Framework is to manipulate
'   data in the form of objects.  Under certain
'   circumstances, particularly under situations of
'   misuse or where the user is unfamiliar the
'   product, it would be possible to damage or
'   destroy data.  The author cannot, and will not,
'   be responsible for such use of this product or
'   demonstration package.
'
' To-Do:
'   DataWrapper: support Validate event
'
' Errors:
'
' Done:
'   Get/Let Properties for AbsolutePosition
'   Full test with errors enabled
'   Identify the Class Module Name which "does not
'       understand" (e.g. "ObjectNewObjectOfMyClass",
'       etc.) in error mesages
'   Not Done (avoiding .Rebind due to invalid state
'       is not informational to the user):
'       Move readiness code from NewVBOF...Wrapper
'           to Wrapper.Rebind
'   Coll: remove need for ObjectLink.CLS
'   Method Form_QueryUnload (Form, Wrappers())
'   RecordSetWrapper: as a subset of the
'       DataWrapper
'   confirm all RegisteredEventObjects are
'       cleaned-up
'   check Object.ObjectDataSource before
'       actually going to the database in
'       OMgr.NewObject
'   Addresses are missing their States, Persons
'       are missing their Mothers and Fathers
'   DBGrid support (remaining Unbound functions)
'   use ListBoxWrappers in DBGrid example
'       (for States, Genders, MaritalStatus)
'   ListBoxWrapper.Rebind
'   OMgr.NewListBoxWrapper: use newLBWrapper.Rebind
'   Clinton's are missing their Address
'   non-Access-specific SQL
'   Add "Set Chelsea.Mother = Hillary" and
'       "Set Chelsea.Father = Bill" to
'       CreateTestData
'   Add "Set Address.State = States.Item(x)" to
'       CreateTestData
'   PopulateCollection
'       RecordSet:=, DB:=,
'       invokes InstantiateFromDB or InstnatiateFromRS
'   NewObject
'       DB:=, SampleObject:=, SQL:=, ObjectID:=,
'       ODBCPassThru:=, NullIfNotFound:=T|F,
'       ANSISQL:=T|F
'   elimiate ListBox:= from Property Get & Sets
'       to be able to remove corresp parm from
'       application calls to Wrapper
'   don't Coll.DetachFromLBWrapper ... would disable
'       support for 1:many (Coll:Wrappers)
'       Figure another way to free the prev Wrapper
'   function to return an instantiated object, given
'       TypeName & ID
'   single copy of StateCodes, MaritalStatus, etc.
'   support Meth=SystemObject(TypeName:=, ObjectID:=)
'   incorp code currently required in methods such
'       as "Persons", "Addresses", etc.
'       (Meth=ManageCollection)
'   Support ODBC Pass Thru
'   Elim redundant "With pvtCurrentPerson : .Name = efName"
'       in demo forms
'   Speed performance by checking for Key=(TypeName)&" "&ObjectID
'       before scanning full SystemObjects
'   (Error) .Replace not deleting link to previous item
'   (Error) .RemoveCollection removes objects prematurely
'       (try the 2 nonDataControl windows, close
'       one, then go after the objects from the other)
'   (Error) Coll.Remove deletes the parent linkage, but
'       that should be persistent
'   added ANSI SQL support (optional)
'   enhanced RecordSet wrapper capability with
'       MoveFirst, MoveLast, FindFirst, FindLast,
'       FindNext, FindPrevious, BOF, EOF
'   CollectionIndex(Where:=FindString)
'   Use-at-your-own-risk message (.txt, in Intro.FRM)
'   propagate code on ListBoxDemo.RefreshCustomerList
'       for dealing with a removed object which had
'       previously been the "pvtCurrent" object
'   Test ParentsOfObject()
'   Set (all) tempObject = Nothing
'   Incorp State, MaritalStatus, Gender objects into
'       GUI examples
'   Hold position of CurrentObject in DataControl
'       example
'   Hold position of CurrentObject in DataControl
'       example
'   need to remove item from collection before
'       .TriggerObjectEvent Event=RemovedItem
'       (Trigger between Collections)
'   Finish ListBox example: "Add", "Upd", "Del"
'   Remove references to each object's own EventManager
'   send "Added" trigger to objects which are
'       newly added to the collection
'   send "Instantiated" trigger to objects which
'       are newly instantiated
'   Rename to VBOF for smaller space consumption
'       in the VB Object Browser
'   Support EventManager interface in ObjectManager
'   TriggerCollectionEvent
'   Support #NoEventMgr mode
'   Support #NoDebugMode mode
'   Support ListBox wrapping
'   Support ComboBox wrapping
'   Support UnRegister from EventManager
'   Execute UnRegister Me in GUI Form_QueryUnload()
'   Support .pvtCloseRecordSet
'   AutoDeleteOrphans
'   Implement .Version method
'   ObjMgr.CompleteCleanUp runs too long, redundantly
'
' Deferred until a later release
'   Lock Manager
'       (not yet needed because Collections are still
'       founded on the RecordSet)
'   SynchronousCommit
'       (same as above)
'   Heterogenous Collections
'       see also SubClasses (below)
'   Instantiating SubClasses
'       Do only "Vehicles", won't do "Cars" or "Buses" or "Trucks", etc.
'   Collection.Sort
'   Separated ComboBoxWrapper functions
'   More properties for ODBC, RecordSet, ListBox,
'       ComboBox, DBGrid, etc.

#If NoEventMgr = False Then
Private pvtVBFWEventManager As VBOFEventManager
#End If
Private pvtSystemCollections As New Collection
Private pvtSystemObjects As New Collection
Private pvtSystemObjectsDictionary As New Collection
Private pvtSystemObjectsDictionaryCollection As New Collection
Private pvtDatabase As Database
Private pvtWorkspace As Workspace
Private pvtVBOFCollectionID As Long
Private pvtDebugMode As Boolean
Private pvtVerbose As Boolean
Private pvtAutoDeleteOrphans As Boolean
Private pvtObjectWasUnique As Boolean

Public HighestObjectID As Long
Public ODBCPassThrough As Boolean
Public ANSISQL As Boolean

Private Const pvtReceiverDoesNotSupportThisMethod = 438

Public Function InitializeObject(Optional Object As Variant) As Boolean
Attribute InitializeObject.VB_Description = "Initializes an object for limited VBOF support"
' Initializes the object in support of
'   VBOF services.
'  Even though the contents of this method may seem
'   trivial, it should still be used because future
'   releases of VBOF will likely contained
'   increased features which may have increased
'   initialization requirements.  Only this method
'   is guaranteed to satisfy those requirements.
'   Thus, having used this method from the outset
'   guarantees the user of transparent object
'   initialization support across future releases.
'
' Example of usage:
'   Set MyObject = New <appropriateClassModule>
'   ObjectManager.InitializeObject _
'       Object:=MyProject

    Set Object.ObjectManager = Me

    With Object
        .ObjectParentCount = 1
        .ObjectChanged = False
        .ObjectAdded = False
        .ObjectDeleted = False
    End With

    InitializeObject = True
End Function

Public Function NewObject(Optional Database As Variant, Optional ObjectID As Variant, Optional Sample As Variant, Optional Parent As Variant, Optional WhereClause As Variant, Optional SQL As Variant, Optional OrderByClause As Variant, Optional ODBCPassThrough As Variant, Optional ANSISQL As Variant) As Variant
Attribute NewObject.VB_Description = "Instantiates a new object from the Sample:="
' Returns an instantiated Object which occurs only
'   singly.  This is typical for contained objects
'   such as Employee.Manager, Address.State,
'   Loan.Property, etc.
'
' Parameter Description:
'   see VBOFObjectManager.ManageCollection
'
' Required Parameters:
'   Sample:=
'   ObjectID:=

    Dim tempObject As Object
    Dim tempParent As Object
    Dim tempIndex As Long
    Dim tempRecordSet As RecordSet
    Dim tempODBCPassThrough As Boolean
    Dim SQLStatement As String
    Dim newChildObject As Object
    Dim tempCollectionEmulationMode As Boolean

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Sample) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewObject' method because the 'ObjectID:=' parameter is missing."
        Set NewObject = Nothing
        Exit Function
    End If
    If IsMissing(WhereClause) _
    And IsMissing(ObjectID) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewObject' method because both the 'ObjectID:=' and 'WhereClause:=' parameters are missing."
        Set NewObject = Nothing
        Exit Function
    End If
    tempCollectionEmulationMode = False
    If Sample.ObjectDataSource = "" _
    Or Err = 438 Then
        tempCollectionEmulationMode = True
    End If
    If Not tempCollectionEmulationMode _
    And Not pvtIsDatabaseSpecified() Then
        Set NewObject = Nothing
        Exit Function
    End If
    If IsMissing(ODBCPassThrough) Then
        tempODBCPassThrough = False
    Else
        tempODBCPassThrough = ODBCPassThrough
    End If
    If IsMissing(Parent) Then
        Set tempParent = Nothing
    Else
        Set tempParent = Parent
    End If

' check each of the objects known at this time
'   by their ObjectID
    If Not IsMissing(ObjectID) Then
        If CLng(ObjectID) > 0 Then
            Sample.ObjectID = CLng(ObjectID)
            tempIndex = _
                pvtObjectIndexInSystemObjects _
                    (Object:=Sample)
        Else
            Set NewObject = Nothing
            Exit Function
        End If
    Else
        tempIndex = -1
    End If

' if found, return the located object
    If tempIndex > 0 Then
        Set tempObject = _
            pvtSystemObjects.Item _
                (tempIndex)

' increase the ParentCount of the previously
'   existing object
        tempObject.ObjectParentCount = _
            tempObject.ObjectParentCount + 1

        Set NewObject = _
            tempObject
        Exit Function
    End If

' Object wasn't found.
'   try the database
' Ensure the object is ready for Database access
    If tempCollectionEmulationMode Then
        Set NewObject = Nothing
        Exit Function
    End If

' must retrieve it from the database
    SQLStatement = _
        "SELECT * FROM " & _
        Sample.ObjectDataSource & _
        " WHERE "
    If Not IsMissing(ObjectID) Then
        SQLStatement = _
            SQLStatement & _
                "ObjectID = " & _
                CStr(ObjectID)
    ElseIf Not IsMissing(WhereClause) Then
        SQLStatement = _
            SQLStatement & _
                WhereClause
    End If

' retrieve the data row
    Set tempRecordSet = _
        pvtDatabase. _
            OpenRecordset( _
                SQLStatement, _
                dbOpenDynaset + pvtODBCPassThrough(tempODBCPassThrough))

' check for NoRecords
    If tempRecordSet.RecordCount < 1 Then
        Set NewObject = Nothing
        Exit Function
    End If

' have the Sample Object return an instantiated
'   copy of itself
    Set newChildObject = _
        Me.pvtInstantiateNewObjectFromSample _
             (Sample:=Sample)
    If newChildObject Is Nothing Then
        Set NewObject = Nothing
        Exit Function
    End If

' initialize the NewChild.ObjectID temporarily
'   so the AddUniqueObject will register the
'   correct ObjectID (and avoid an endless loop
'   in the case of SpouseA <-> SpouseB)
    newChildObject.ObjectID = ObjectID

' add the object to the SystemObjects Collection
    Set tempObject = _
        AddUniqueObject( _
            Object:=newChildObject, _
            Parent:=tempParent)

' have the new instantiated object copy populate
'   itself from this RecordSet row
    Set newChildObject = _
        Me.pvtObjectInitializeFromRecordSet( _
            Object:=newChildObject, _
            RecordSet:=tempRecordSet)
    If newChildObject Is Nothing Then
        Set NewObject = Nothing
        Exit Function
    End If

    Set NewObject = _
        tempObject
End Function

Public Function pvtObjectInitializeFromRecordSet(Optional Object As Variant, Optional RecordSet As Variant) As Variant

    On Local Error Resume Next

' have the object copy populate
'   itself from this RecordSet row
    Object _
        .ObjectInitializeFromRecordSet (RecordSet)
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(Object) & "' does not support the method 'InitializeFromRecordSet'." & vbCrLf & "Object cannot be supported by VBOF without this method."
        Set pvtObjectInitializeFromRecordSet = Nothing
        Exit Function
    End If

    Set pvtObjectInitializeFromRecordSet = Object
End Function

Public Function pvtInstantiateNewObjectFromSample(Optional Sample As Variant) As Variant

    On Local Error Resume Next

' instantiate the new object
    Set pvtInstantiateNewObjectFromSample = _
        Sample. _
            ObjectNewInstanceOfMyClass
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(Sample) & "' does not support the method 'ObjectNewInstanceOfMyClass'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
        Set pvtInstantiateNewObjectFromSample = Nothing
        Exit Function
    End If

    Set pvtInstantiateNewObjectFromSample. _
        ObjectManager = Me
End Function

Public Function ManageCollection(Optional Collection As Variant, Optional ObjectID As Variant, Optional Database As Variant, Optional Sample As Variant, Optional Parent As Variant, Optional WhereClause As Variant, Optional SQL As Variant, Optional OrderByClause As Variant, Optional CollectionEmulationMode As Variant, Optional ANSISQL As Variant, Optional ODBCPassThrough As Variant) As Variant
Attribute ManageCollection.VB_Description = "Manages an VBOFCollection"
' Returns the entire collection if the ObjectID
'   parameter is missing,
'   or
' Returns a Person object whose ObjectID matches the
'   ObjectID parameter.
'
' Completely manages a contained Collection of
'   objects on behalf of a given containing object
'
' Example of usage:
'    Public Function Persons(Optional ObjectID As Variant) As Variant
'    Dim tempNewPerson As New Person
'    Set Persons = _
'        ObjectManager. _
'            ManageCollection( _
' (R)            Collection:=myPersonsCollection,
' (R)            Parent:=Me,
' (O)            ObjectID:=ObjectID,
' (O)            Sample:=tempNewPerson,
' (O)            Database:=MyDatabase,
' (O)            SQL:=sql statement,
' (O)            OrderByClause:="LastName ASC, FirstName ASC",
' (O)            WhereClause:=where clause,
' (O)            ANSISQL:=True|False,
' (O)            ODBCPassThrough:=True|False
'
' Parameter Description:
'   Collection:= (Required) the VBOFCollection object
'       to be managed
'   Parent:= (Required) defines the object which is
'       the "Parent" of the objects to be collected.
'       The value to specify is typically "Me".
'       In OO terminology, this is the "containing"
'       object
'   Database:= (Optional) the VB Database Object containing
'       the necessary Table
'   Sample:= (Optional, but recommended) a
'       throw-away object of the desired Class which
'       VBOFCollection can use to help instantiate
'       new objects to be placed into the
'       Collection
'   WhereClause:= (Optional) defines the SQL Where
'       Clause to be used to select the desired
'       rows from the Table.
'       Normally, VBOFCollection creates all
'       necessary Where Clauses to effect containment
'   SQL:= (Optional, not recommended) defines the
'       SQL statement to be used to select the
'       desired rows from the Table.
'       Normally, VBOFCollection creates the
'       necessary SQL statement to effect containment
'   OrderByClause:= (Optional) defines the SQL Order
'       By Clause to be used to select the desired
'       rows from the Table.
'       Normally, VBOFCollection does not provide an
'       Order By Clause
'   ANSISQL:= (Optional) control whether or not
'       ANSI SQL should be used when linking objects
'       for containment purposes
'   ODBCPassThrough:= (Optional) controls whether
'       of not the SQL statements used by
'       VBOFCollection to link parent and child objects
'       should be executed on an ODBC database server

    Dim tempDatabase As Database

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Collection) _
    Or IsMissing(Parent) _
    Or IsMissing(Sample) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.ManageCollection' method because either the 'Collection:=', 'Parent:=' or 'Sample:=' parameter is missing."
        Set ManageCollection = Nothing
        Exit Function
    End If

' use a valid Database parameter
    If Not IsMissing(Database) Then
        Set tempDatabase = Database
    Else
        Set tempDatabase = pvtDatabase
    End If

' check for never-before referenced Collection
    If Collection Is Nothing Then
        Set Collection = _
            ObjectManager.NewVBOFCollection _
                (Parent:=Parent)
    End If

' check for the need to populate the collection
'   from the database
    If Not Collection. _
            pvtDatabaseHasBeenReferenced Then

' pass-along any known Database parameters
        Collection. _
            SetDatabaseParameters _
                Database:=tempDatabase, _
                SQL:=SQL, _
                ANSISQL:=ANSISQL, _
                WhereClause:=WhereClause, _
                OrderByClause:=OrderByClause, _
                ODBCPassThrough:=ODBCPassThrough

' instantiate the contained objects
        Set Collection = _
            Collection. _
                PopulateCollection( _
                    Database:=tempDatabase, _
                    Parent:=Parent, _
                    Sample:=Sample)
    End If

' check for a request for a specific Object
    If Not IsMissing(ObjectID) Then
        Set ManageCollection = _
            Collection.Item(ObjectID)

' else, return the entire collection
    Else
        Set ManageCollection = _
            Collection
    End If
End Function

Public Function pvtWrapperUseCollection(Optional CollectionParm As Variant, Optional pvtCollection As Variant, Optional Verbose As Variant, Optional WrapperName As Variant) As Variant

    On Local Error Resume Next

    If Not IsMissing(CollectionParm) Then
        If Not CollectionParm Is Nothing Then
            If TypeName(CollectionParm) = "VBOFCollection" Then
                Set pvtCollection = CollectionParm
                Set pvtWrapperUseCollection = pvtCollection
                Exit Function
            End If
        End If
    End If

    If Not IsMissing(pvtCollection) Then
        If Not pvtCollection Is Nothing Then
            If TypeName(pvtCollection) = "VBOFCollection" Then
                Set pvtWrapperUseCollection = pvtCollection
                Exit Function
            End If
        End If
    End If

' error
    If Not IsMissing(Verbose) Then
        If Verbose Then
            pvtErrorMessage TypeName(Me) & " cannot process the " & WrapperName & " methods because the 'Collection' parameter is missing and no suitable default has been established." & vbCrLf & vbCrLf & "If using the VBOF" & WrapperName & "Wrapper, please ensure that the 'ObjectManager.NewVBOF" & WrapperName & "Wrapper' method has been properly executed and references the appropriate Collection and " & WrapperName & " control."
        End If
    End If

    Set pvtWrapperUseCollection = Nothing
End Function

Public Function pvtWrapperUseControl(Optional ControlParm As Variant, Optional pvtControl As Variant, Optional SupportedNames As Variant, Optional WrapperName As Variant, Optional Verbose As Variant) As Variant

    On Local Error Resume Next

    If Not IsMissing(ControlParm) Then
        If Not ControlParm Is Nothing Then
            If InStr(SupportedNames, TypeName(ControlParm)) > 0 Then
                Set pvtControl = ControlParm
                Set pvtWrapperUseControl = pvtControl
                Exit Function
            End If
        End If
    End If

    If Not IsMissing(pvtControl) Then
        If Not pvtControl Is Nothing Then
            If InStr(SupportedNames, TypeName(pvtControl)) > 0 Then
                Set pvtWrapperUseControl = pvtControl
                Exit Function
            End If
        End If
    End If

' error
    If Not IsMissing(Verbose) Then
        If Verbose Then
            pvtErrorMessage TypeName(Me) & " cannot process the " & WrapperName & " methods because the '" & WrapperName & "' parameter is missing and no suitable default has been established." & vbCrLf & vbCrLf & "If using the VBOF" & WrapperName & "Wrapper, please ensure that the 'ObjectManager.NewVBOF" & WrapperName & "Wrapper' method has been properly executed and references the appropriate Collection and " & WrapperName & " control."
        End If
    End If

    Set pvtWrapperUseControl = Nothing
End Function

Public Function pvtWrapperVerifyCollection(Optional Collection As Variant, Optional pvtCollection As Variant, Optional Verbose As Variant, Optional WrapperName As Variant) As Boolean

    Dim tempCollection As Variant

    If Not IsMissing(Collection) Then
        Set tempCollection = Collection
    Else
        Set tempCollection = pvtCollection
    End If

    If pvtWrapperUseCollection( _
        CollectionParm:=tempCollection, _
        pvtCollection:=pvtCollection, _
        Verbose:=Verbose, _
        WrapperName:=WrapperName) Is Nothing _
    Then
        pvtWrapperVerifyCollection = False
    Else
        pvtWrapperVerifyCollection = True
    End If
End Function

Public Function pvtWrapperVerifyControl(Optional Control As Variant, Optional pvtControl As Variant, Optional Verbose As Variant, Optional WrapperName As Variant) As Boolean

    Dim tempControl As Variant

    If Not IsMissing(Control) Then
        Set tempControl = Control
    Else
        Set tempControl = pvtControl
    End If

    If pvtWrapperUseControl( _
        ControlParm:=tempControl, _
        pvtControl:=pvtControl, _
        Verbose:=Verbose, _
        WrapperName:=WrapperName) Is Nothing _
    Then
        pvtWrapperVerifyControl = False
    Else
        pvtWrapperVerifyControl = True
    End If
End Function


Public Function NewVBOFRecordSetWrapper(Optional Collection As Variant, Optional DataControl As Variant) As VBOFDataWrapper
Attribute NewVBOFRecordSetWrapper.VB_Description = "Instantiates a new VBOFRecordSetWrapper"
' Returns a new VBOFRecordSetlWrapper for the
'   specified VBOFCollection
'
' Coding Example:
'   Dim MyRecordSetWrapper as VBOFRecordSetWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyRecordSetWrapper = _
'       ObjectManager.NewVBOFRecordSetWrapper ( _
'           Collection:=MyCollection)

    Dim tempNewRecordSetWrapper As New VBOFRecordSetWrapper

    Set tempNewRecordSetWrapper.ObjectManager = Me

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFRecordSetWrapper' method because the 'Collection:=' parameter is missing."
        Set NewVBOFRecordSetWrapper = Nothing
        Exit Function
    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewRecordSetWrapper.Collection = _
                Collection
        End If
    End If

' have the new wrapper bind itself to the RecordSet
    If Not tempNewRecordSetWrapper.Collection Is Nothing Then
        tempNewRecordSetWrapper.Rebind
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewRecordSetWrapper.ObjectID = _
        pvtVBOFCollectionID

    Set NewVBOFRecordSetWrapper = _
        tempNewRecordSetWrapper
End Function

Public Function NewVBOFDBGridWrapper(Optional Collection As Variant, Optional DBGrid As Variant) As VBOFDBGridWrapper
Attribute NewVBOFDBGridWrapper.VB_Description = "Instantiates a new VBOFDBGridWrapper"
' Returns a new VBOFDBGridWrapper for the
'   specified VBOFCollection (Required) and
'   DBGrid (Optional)
'
' Coding Example:
'   Dim MyDBGridWrapper as VBOFDBGridWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyDBGridWrapper = _
'       ObjectManager.NewVBOFDBGridWrapper ( _
'           Collection:=MyCollection, _
'           DBGrid:=MyDBGrid)

    Dim tempNewDBGridWrapper As New VBOFDBGridWrapper

    Set tempNewDBGridWrapper.ObjectManager = Me

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDBGridWrapper' method because the 'Collection:=' parameter is missing."
        Set NewVBOFDBGridWrapper = Nothing
        Exit Function
    End If
    If IsMissing(DBGrid) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDBGridWrapper' method because the 'DBGrid:=' parameter is missing."
        Set NewVBOFDBGridWrapper = Nothing
        Exit Function
    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewDBGridWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(DBGrid) Then
        If Not DBGrid Is Nothing Then
            Set tempNewDBGridWrapper.DBGrid = _
                DBGrid
        End If
    End If

' have the new wrapper bind itself to the DBGrid
    If Not tempNewDBGridWrapper.DBGrid Is Nothing Then
        If Not tempNewDBGridWrapper.Collection Is Nothing Then
            tempNewDBGridWrapper.Rebind _
                Collection:=Collection, _
                DBGrid:=DBGrid
        End If
    End If

' generate a unique ObjectID for the new VBOFDBGridWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewDBGridWrapper.ObjectID = _
        pvtVBOFCollectionID

    Set NewVBOFDBGridWrapper = _
        tempNewDBGridWrapper
End Function

Private Function pvtIsDatabaseSpecified() As Integer
' Determine whether or not the database has been
'   specified

    If pvtDatabase Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot function without having been provided the name of the database.  Use the 'Database:=' parameter to specify the database."
        pvtIsDatabaseSpecified = False
        Exit Function
    End If

    pvtIsDatabaseSpecified = True
End Function


Public Function Collection(Optional ObjectID As Variant, Optional Index As Variant) As VBOFCollection
Attribute Collection.VB_Description = "Private"
' Return the VBOFCollection having the specified
'   ObjectID or Index

    On Local Error Resume Next

    Set Collection = Nothing

' bullet-proofing
    If IsMissing(ObjectID) And IsMissing(Index) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Collection' method because the 'ObjectID:=' and the 'Index:=' parameters were missing."
        Exit Function
    End If

    If Not IsMissing(Index) Then
        Set Collection = _
            pvtSystemCollections(Index)

    ElseIf Not IsMissing(ObjectID) Then
        Set Collection = _
            pvtSystemCollections(CStr(ObjectID))
    End If

End Function

Public Function CompleteObjectCleanUp() As Boolean
Attribute CompleteObjectCleanUp.VB_Description = "Private"
' Removes all known Collections and Objects from the
'   current environment
' Note: does NOT sever the automatic object
'   containment links between containing objects and
'   contained objects

    Dim tempCollection As VBOFCollection

    On Local Error Resume Next

    For Each tempCollection In pvtSystemCollections

        RemoveCollection _
            Collection:=tempCollection, _
            NoDelete:=True, _
            CleanUpMode:=True

        pvtSystemCollections.Remove 1

    Next tempCollection

    CompleteObjectCleanUp = True
End Function

Public Function DisplayDebugMessage(Optional Message As Variant) As Long
Attribute DisplayDebugMessage.VB_Description = "Private"

#If NoDebugMode = False Then
    DisplayDebugMessage = True

    If Not pvtDebugMode Then
        Exit Function
    End If

    Debug.Print Format$(Now, "yyyy/mm/dd hh:nn:ss") & " " & Message
#Else
    DisplayErrorMessage TypeName(Me) & " (Warning) the .DisplayDebugMessage method has been executed, but the conditional compilation parameter 'NoDebugMode = -1' has been specified.  No Event code is generated unless 'NoDebugMode = 0' or 'NoDebugMode' is missing from the conditional compilation string altogether."
#End If
End Function


Public Function NewVBOFListBoxWrapper(Optional Collection As Variant, Optional ListBox As Variant) As VBOFListBoxWrapper
Attribute NewVBOFListBoxWrapper.VB_Description = "Instantiates a new VBOFListBoxWrapper"
' Returns a new VBOFListBoxWrapper for the
'   specified VBOFCollection (Required) and
'   ListBox (Optional)
'
' Coding Example:
'   Dim MyListBoxWrapper as VBOFListBoxWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyListBoxWrapper = _
'       ObjectManager.NewVBOFListBoxWrapper ( _
'           Collection:=MyCollection, _
'           ListBox:=MyListBox)

    Dim tempNewListBoxWrapper As New VBOFListBoxWrapper

    Set tempNewListBoxWrapper.ObjectManager = Me

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFListBoxWrapper' method because the 'Collection:=' parameter is missing."
        Set NewVBOFListBoxWrapper = Nothing
        Exit Function
    End If
    If IsMissing(ListBox) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFListBoxWrapper' method because the 'ListBox:=' parameter is missing."
        Set NewVBOFListBoxWrapper = Nothing
        Exit Function
    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewListBoxWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(ListBox) Then
        If Not ListBox Is Nothing Then
            Set tempNewListBoxWrapper.ListBox = _
                ListBox
        End If
    End If

' have the new wrapper bind itself to the ListBox
    If Not tempNewListBoxWrapper.ListBox Is Nothing Then
        If Not tempNewListBoxWrapper.Collection Is Nothing Then
            tempNewListBoxWrapper.Rebind _
                Collection:=Collection, _
                ListBox:=ListBox
        End If
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewListBoxWrapper.ObjectID = _
        pvtVBOFCollectionID

    Set NewVBOFListBoxWrapper = _
        tempNewListBoxWrapper
End Function

Public Function NewVBOFDataWrapper(Optional Collection As Variant, Optional DataControl As Variant) As VBOFDataWrapper
Attribute NewVBOFDataWrapper.VB_Description = "Instantiates a new VBOFDataWrapper"
' Returns a new VBOFDataWrapper for the
'   specified VBOFCollection, and optionally the
'   DataControl
'
' Coding Example:
'   Dim MyDataWrapper as VBOFDataWrapper
'   Dim MyCollection as VBOFCollection
'   Set MyDataWrapper = _
'       ObjectManager.NewVBOFDataWrapper ( _
'           Collection:=MyCollection)
' or
'   Set MyDataWrapper = _
'       ObjectManager.NewVBOFDataWrapper ( _
'           Collection:=MyCollection, _
'           DataControl:=MyDataControl)

    Dim tempNewDataWrapper As New VBOFDataWrapper

    Set tempNewDataWrapper.ObjectManager = Me

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.NewVBOFDataWrapper' method because the 'Collection:=' parameter is missing."
        Set NewVBOFDataWrapper = Nothing
        Exit Function
    End If

' initialize the Collection
    If Not IsMissing(Collection) Then
        If Not Collection Is Nothing Then
            Set tempNewDataWrapper.Collection = _
                Collection
        End If
    End If

    If Not IsMissing(DataControl) Then
        If Not DataControl Is Nothing Then
            Set tempNewDataWrapper.DataControl = _
                DataControl
        End If
    End If

' have the new wrapper bind itself to the DataControl
    If Not tempNewDataWrapper.DataControl Is Nothing Then
        If Not tempNewDataWrapper.Collection Is Nothing Then
            tempNewDataWrapper.Rebind _
                Collection:=Collection, _
                DataControl:=DataControl
        End If
    End If

' generate a unique ObjectID for the new VBOFListBoxWrapper
    pvtVBOFCollectionID = _
        pvtVBOFCollectionID + 1
    tempNewDataWrapper.ObjectID = _
        pvtVBOFCollectionID

    Set NewVBOFDataWrapper = _
        tempNewDataWrapper
End Function

Public Property Get ObjectWasUnique() As Boolean
Attribute ObjectWasUnique.VB_Description = "Private"
    ObjectWasUnique = pvtObjectWasUnique
End Property

Public Function ParentsOfObject(Optional Object As Variant) As Collection
Attribute ParentsOfObject.VB_Description = "Returns a VB Collection of all of the known Parents (containers) of the specified object"
' Returns a Collection of VBOFCollections which
'   are Parents of Object.
' Note: knowledge of an Object's parents is not
'   considered good object-oriented technique

    Dim tempVBOFCollection As VBOFCollection
    Dim tempCollection As New Collection
    Dim I As Long

' process each VBOFCollection
    I = 1
    For Each tempVBOFCollection In pvtSystemCollections

' process each object therein
        If pvtObjectIndexInCollection( _
            Object:=Object, _
            Collection:=tempVBOFCollection) > 0 _
        Then
            tempCollection.Add _
                Item:=tempVBOFCollection, _
                Key:=CStr(I)

            I = I + 1
        End If

    Next tempVBOFCollection

    Set ParentsOfObject = tempCollection
End Function

Private Function pvtObjectIndexInCollection(Optional Object As Variant, Optional Collection As Variant) As Long
' Returns the index of the Object within the
'   Collection

    Dim tempObject As Object
    Dim I As Long

' check each of the Objects defined to the
'   Collection
    I = 0
    For I = 1 To Collection.Count
        Set tempObject = Collection.Item(I)

' return the Collection's index position
        If TypeName(tempObject) = TypeName(Object) Then
            If tempObject.ObjectID = Object.ObjectID Then
                pvtObjectIndexInCollection = I
                Exit Function
            End If
        End If
    Next I

    pvtObjectIndexInCollection = -1
End Function

Private Function pvtObjectParent(Optional Object As Variant) As VBOFCollection
' Returns the first VBOFCollection found
'   to contain Object

    Dim tempVBOFCollection As VBOFCollection
    Dim tempObject As Object

' process each VBOFCollection
    For Each tempVBOFCollection In pvtSystemCollections

' process each object therein
        If pvtObjectIndexInCollection( _
            Object:=Object, _
            Collection:=tempVBOFCollection) > 0 _
        Then
            Set pvtObjectParent = tempVBOFCollection
            Exit Function
        End If
    Next tempVBOFCollection

' didn't find an Parent
    Set pvtObjectParent = Nothing
End Function

Private Function pvtODBCPassThrough(ODBCPassThrough As Boolean) As Long

    If ODBCPassThrough Then
        pvtODBCPassThrough = dbSQLPassThrough
    Else
        pvtODBCPassThrough = 0
    End If
End Function

Public Function RegisterForObjectEvent(Optional TriggerObject As Variant, Optional TriggerObjectType As Variant, Optional TriggerEvent As Variant, Optional RegisterObject As Variant, Optional RegisterType As Variant) As Boolean
Attribute RegisterForObjectEvent.VB_Description = "Registers an object as a recipient of certain object-related events"
' Pass-through to the EventManager

#If NoEventMgr = False Then
    RegisterForObjectEvent = _
        pvtVBFWEventManager. _
            RegisterForObjectEvent( _
                TriggerObject:=TriggerObject, _
                TriggerObjectType:=TriggerObjectType, _
                TriggerEvent:=TriggerEvent, _
                RegisterObject:=RegisterObject, _
                RegisterType:=RegisterType)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .RegisterForObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    RegisterForObjectEvent = True
End Function

Public Function RegisterForCollectionEvent(Optional Collection As Variant, Optional RegisterObject As Variant, Optional TriggerEvent As Variant) As Boolean
Attribute RegisterForCollectionEvent.VB_Description = "Registers an object as a recipient of certain VBOFCollection-related events"
' Pass-through to the EventManager

#If NoEventMgr = False Then
    RegisterForCollectionEvent = _
        pvtVBFWEventManager. _
            RegisterForCollectionEvent( _
                Collection:=Collection, _
                TriggerEvent:=TriggerEvent, _
                RegisterObject:=RegisterObject)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .RegisterForCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    RegisterForCollectionEvent = True
End Function


Public Function RemoveCollection(Optional Collection As Variant, Optional NoDelete As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute RemoveCollection.VB_Description = "Private"
' Remove the Collection and its contents
'
' Note: refer to the value of CleanUpMode to
'   determine whether or not the automatic object
'   containment links between containing objects and
'   contained objects will be severed

    On Local Error Resume Next

    Collection.pvtCloseRecordSet

    EmptyCollection _
        Collection:=Collection, _
        NoDelete:=NoDelete, _
        CleanUpMode:=CleanUpMode

    UnRegisterForAllEvents _
        RegisterObject:=Collection, _
        CleanUpMode:=CleanUpMode

    Set Collection = Nothing

    RemoveCollection = True
End Function


Public Function RemoveWrapper(ParamArray WrapperCollection())
Attribute RemoveWrapper.VB_Description = "Private"
' Removes Wrapper(s) in an orderly manner.
'
' Note: See also method "Form_QueryUnload"

    Dim I As Long

    On Local Error Resume Next

    For I = 0 To UBound(WrapperCollection)
        If InStr(TypeName(WrapperCollection(I)), "Wrapper") > 0 Then
            WrapperCollection(I).Unbind

            Me.TerminateObject _
               WrapperCollection(I)
        End If

        Set WrapperCollection(I) = Nothing
    Next I
End Function


Public Function SystemObject(Optional TypeName As Variant, Optional ObjectID As Variant) As Variant
Attribute SystemObject.VB_Description = "Private"
' Returns an Object whose TypeName matches TypeName
'   and whose Object matches ObjectID
' Note: in most cases, the results of this method
'   and the use thereof is not considered good
'   object-oriented behavior

    Dim tempObject As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(TypeName) _
    Or IsMissing(ObjectID) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.SystemObject' method because either the 'TypeName:=' or 'ObjectID:=' parameter is missing."
        Set SystemObject = Nothing
        Exit Function
    End If

' find the desired object and return ir
    For Each tempObject In pvtSystemObjects
        If TypeName(tempObject) = TypeName Then
            If tempObject.ObjectID = ObjectID Then
                Set SystemObject = tempObject
                Exit Function
            End If
        End If

    Next tempObject

    Set SystemObject = Nothing
End Function

Public Function SystemObjects() As Collection
Attribute SystemObjects.VB_Description = "Private"
' Returns a Collection (that's the VB4 Collection
'   object, not the VBOFCollection object)
'   which contains a reference to each object
'   currently being managed by VBOFObjectManager

    Set SystemObjects = pvtSystemObjects
End Function

Public Function SystemCollections() As Collection
Attribute SystemCollections.VB_Description = "Private"
' Returns a Collection (that's the VB4 Collection
'   object, not the VBOFCollection object)
'   which contains a reference to each
'   VBOFCollection currently being managed by
'   VBOFObjectManager

    Set SystemCollections = pvtSystemCollections
End Function

Private Function pvtIsExactlyTheSameObject(Optional Object1 As Variant, Optional Object2 As Variant) As Boolean
' Determines whether two objects are exactly the
'   same.
' Note: this is a kind of kludge, but necessary
'   because VB doesn't return pointers to the objects

    Dim tempObjectID As Long

' test by changing one, then checking the other
    tempObjectID = Object1.ObjectID
    Object1.ObjectID = -1
    If Object2.ObjectID = -1 Then
        pvtIsExactlyTheSameObject = True
    Else
        pvtIsExactlyTheSameObject = False
    End If

' reinstate the previous value
    Object1.ObjectID = tempObjectID
End Function

Public Function RemoveObject(Optional Object As Variant, Optional Parent As Variant, Optional Collection As Variant, Optional NoDelete As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute RemoveObject.VB_Description = "Removes an object from VBOF and from the databse"
' Remove the Object from the specified Parent.
'   Delete the Object if its ParentCount = 0
' Note: if a Table is supporting the Collection
'   then the VBOF automatic containment link to
'   the contained object (Collection.Parent) is also
'   severed (unless CleanUpMode:=True)

    Dim tempIndex As Long
    Dim tempParent As VBOFCollection
    Dim tempNoDelete As Boolean
    Dim tempCleanUpMode As Boolean

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Object) And IsMissing(Parent) And IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.RemoveObject' method for this object because either the 'Object:=', 'Collection:=' or the 'Parent:=' parameter is missing"
        RemoveObject = False
        Exit Function
    End If
    If Object.ObjectID < 0 Then
        RemoveObject = False
        Exit Function
    End If

    If IsMissing(NoDelete) Then
        tempNoDelete = False
    Else
        tempNoDelete = NoDelete
    End If

    If IsMissing(CleanUpMode) Then
        tempCleanUpMode = False
    Else
        tempCleanUpMode = CleanUpMode
    End If

' if the Parent:= is missing, find the first Parent
'   Note: herein, a Parent is an VBOFCollection
    If Not IsMissing(Parent) Then
        Set tempParent = Parent
    ElseIf Not IsMissing(Collection) Then
        Set tempParent = Collection
    Else
        Set tempParent = _
            pvtObjectParent(Object)
    End If

' remove event registrations
#If NoEventMgr = False Then
    UnRegisterForAllEvents _
        RegisterObject:=Object, _
        CleanUpMode:=CleanUpMode
#End If

' schedule orphans to be deleted
    If tempParent Is Nothing Then
        Object.ObjectParentCount = 0
    End If

' if there's only 1 Parent (or less)
    If ParentsOfObject(Object).Count <= 1 Then

' remove the Object from the specified Parent,
'   and delete it according to NoDelete
        If Not tempParent Is Nothing Then
            tempParent.Remove _
                Item:=Object, _
                NoDelete:=tempNoDelete, _
                CleanUpMode:=CleanUpMode
        End If

' free the Object
        pvtFreeObject _
            Object:=Object

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveObject' has removed the ObjectType=" & _
            TypeName(Object) & _
            ", ObjectID=" & _
            Object.ObjectID
        End If
#End If

        RemoveObject = True
        Exit Function

' remove the Object from the specified Parent,
'   but don't delete it
    Else
        Parent.Remove _
            Item:=Object, _
            NoDelete:=True, _
            CleanUpMode:=CleanUpMode

' drop Object's ParentCount by 1
        Object.ObjectParentCount = _
            Object.ObjectParentCount - 1

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveObject' has decremented the ObjectParentCount to " & Object.ObjectParentCount & " for ObjectType=" & _
            TypeName(Object) & _
            ", ObjectID=" & _
            Object.ObjectID
        End If
#End If

        RemoveObject = True
        Exit Function
    End If
End Function

Private Function pvtErrorMessage(Optional ErrorMessage As Variant) As Long
    pvtErrorMessage = _
        DisplayErrorMessage(ErrorMessage)
End Function


Private Function pvtObjectIndexInSystemObjects(Optional Object As Variant) As Long
' Return the Index of Object in the collection
'   of system objects

    Dim tempObject As Object
    Dim I As Long

    On Local Error Resume Next

' quick-check to see if the object exists
    Set tempObject = _
        pvtSystemObjects(TypeName(Object) & " " & _
        CStr(Object.ObjectID))
    If Err = 5 Then
        pvtObjectIndexInSystemObjects = -1
        Exit Function
    End If

' the object likely exists in the SystemObjects.
'   find its Index.

' check each of the objects known at this time
    I = 0
    For Each tempObject In pvtSystemObjects
        I = I + 1

' return the collection's index position
        If TypeName(tempObject) = TypeName(Object) Then
            If tempObject.ObjectID = Object.ObjectID Then
                pvtObjectIndexInSystemObjects = I
                Exit Function
            End If
        End If
    Next tempObject

 ' return "not found"
    pvtObjectIndexInSystemObjects = -1
    Exit Function
End Function


Public Function AddUniqueObject(Optional Object As Variant, Optional Parent As Variant) As Variant
Attribute AddUniqueObject.VB_Description = "(Private) Ensures no duplicate instances of a given object exist"
' Return a system-wide unique object which is the
'   Item, or an already existing, functionally
'   equivalent of the Item
' Note: this method, while public, is designed to be
'   invoked only by the .Add method of an instance
'   of VBOFCollection.  Any other use must make
'   allowances for Object to have been freed and
'   replaced by an equivalent object which was
'   found to have already existed under the control
'   of VBOFObjectManager

    Dim tempObject As Object
    Dim tempIndex As Long

    On Local Error Resume Next
    pvtObjectWasUnique = False

' bullet-proofing
    If IsMissing(Object) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.AddUniqueObject' method for this object because the 'Object:=' parameter is missing"
        AddUniqueObject = False
        Exit Function
    End If

' initialize all objects that pass through here,
'   in support of VBOF services
    Set Object.ObjectManager = _
        Me

' check each of the objects known at this time
    tempIndex = _
        pvtObjectIndexInSystemObjects _
            (Object:=Object)

' if found, return the located object
    If tempIndex > 0 Then
        Set tempObject = _
            pvtSystemObjects.Item _
                (tempIndex)

' if these are exactly the same object
        If pvtIsExactlyTheSameObject( _
            Object1:=Object, _
            Object2:=tempObject) _
        Then

' increase the ParentCount of the previously
'   existing object
            Object.ObjectParentCount = _
                Object.ObjectParentCount + 1

#If NoDebugMode = False Then
            If DebugMode Then
                DisplayDebugMessage _
                    TypeName(Me) & " 'Add Object' attempt found exact same (already existing) Object.  ObjectType=" & _
                    TypeName(Object) & _
                    ", ObjectID=" & _
                    Object.ObjectID
            End If
#End If

        Else
' else, free the Object (the parameter)
            Object.ObjectID = -1
            Set Object = Nothing
        End If

' return the located object
        Set AddUniqueObject = _
            pvtSystemObjects.Item _
                (tempIndex)

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'Add Object' attempt found an existing Object.  ObjectType=" & _
                TypeName(Object) & _
                ", ObjectID=" & _
                Object.ObjectID
        End If
#End If

        GoTo AddUniqueObject_Exit
    End If

' else, the object is unique
'   add the object to the collection of system objects
    pvtSystemObjects.Add _
        Item:=Object, _
        Key:=TypeName(Object) & " " & CStr(Object.ObjectID)

' mark the object as "Added"
    Object.ObjectAdded = True

' trigger the "Instantiated" event for the new object
#If NoEventMgr = False Then
    TriggerObjectEvent _
        Event:="Instantiated", _
        Object:=Object
#End If

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'Add Object' attempt did not find any existing Object.  The Object was added, ObjectType=" & _
            TypeName(Object) & _
            ", ObjectID=" & _
            Object.ObjectID
    End If
#End If

' initialize the new object in support of
'   VBOF services
    InitializeObject _
        Object:=Object

' return the original object
    Set AddUniqueObject = Object
    pvtObjectWasUnique = True

AddUniqueObject_Exit:
    Set tempObject = Nothing
End Function

Public Function DisplayErrorMessage(Optional ErrorMessage As Variant) As Long
Attribute DisplayErrorMessage.VB_Description = "Private"

    Dim RC As Long

    If Err <> 0 Then
        RC = MsgBox( _
            ErrorMessage & vbCrLf & "Err=" & Err & ", Msg=" & Error(Err) & _
            vbCrLf & "Version=" & Version & ", Date=" & VersionDate, _
            vbOK + vbExclamation, _
            TypeName(Me) & " Run-Time Message")
    Else
        RC = MsgBox( _
            ErrorMessage & _
            vbCrLf & "Version=" & Version, _
            vbOK + vbExclamation, _
            TypeName(Me) & " Run-Time Message")
    End If

    Err = 0
    DisplayErrorMessage = RC
End Function


Public Property Get ObjectManager() As VBOFObjectManager
Attribute ObjectManager.VB_Description = "Private"
    Set ObjectManager = Me
End Property




Public Function ObjectID() As Long
Attribute ObjectID.VB_Description = "Private"
    ObjectID = -1
End Function



Public Function NewVBOFCollection(Optional Database As Variant, Optional Parent As Variant, Optional Owner As Variant) As VBOFCollection
Attribute NewVBOFCollection.VB_Description = "Instantiates a new VBOFCollection"
'  Return a new, properly instantiated
'   VBOFCollection object

    Dim tempVBOFCollection As New VBOFCollection

    On Local Error Resume Next

' generate a unique ObjectID for the new VBOFCollection
    pvtVBOFCollectionID = pvtVBOFCollectionID + 1

' initialize
    Set tempVBOFCollection.ObjectManager = Me
    With tempVBOFCollection
        .ObjectID = pvtVBOFCollectionID
        .AutoDeleteOrphans = Me.AutoDeleteOrphans
    End With

' set any known parameters
    If Not IsMissing(Database) Then
        Set pvtDatabase = Database
    End If
    If Not IsMissing(Owner) Then
        Set tempVBOFCollection.Parent = Owner
    End If
    If Not IsMissing(Parent) Then
        Set tempVBOFCollection.Parent = Parent
    End If

' pass-along any known database parms
    tempVBOFCollection. _
        SetDatabaseParameters _
            ODBCPassThrough:=ODBCPassThrough, _
            ANSISQL:=ANSISQL, _
            Database:=pvtDatabase

' add the new VBOFCollection to the
'   system-wide collection of
'   VBOFCollections, for management
'   purposes
    pvtSystemCollections.Add _
        Item:=tempVBOFCollection

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'NewVBOFCollection' completed, new ObjectID=" & _
            tempVBOFCollection.ObjectID
    End If
#End If

    Set NewVBOFCollection = tempVBOFCollection
End Function


Public Sub Form_QueryUnload(Form As Variant, ParamArray WrapperCollection())
Attribute Form_QueryUnload.VB_Description = "Manages the termination of a Form"
' Cleans-up while a Form is being Unloaded
'
' Programming Example:
'   Private Sub Form_QueryUnload(...)
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.Form_QueryUnload _
'               Me, _
'               MyListBoxWrapper, _
'               MyListBoxOtherWrapper, _
'               MyDBGridWrapper, _
'               MyDBGridOtherWrapper, _
'               . . .
'       End If

' remove event registrations
#If NoEventMgr = False Then
    UnRegisterForAllEvents _
        RegisterObject:=Form, _
        CleanUpMode:=False
#End If

    Me.RemoveWrapper _
        WrapperCollection()

End Sub

Public Function TerminateForm(Form As Variant, ParamArray WrapperCollection())
Attribute TerminateForm.VB_Description = "Private"
' Cleans-up while a Form is being Unloaded.
'
' Note:  This is the equivalent of the method
'   "Form_QueryUnload" but this method's name
'   might be easier for the programmer to remember,
'   given that there is a method named
'   "TerminateObject", as well, used for
'   terminating objects
'
' Programming Example:
'   Private Sub Form_QueryUnload(...)
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.TerminateForm _
'               Me, _
'               MyListBoxWrapper, _
'               MyListBoxOtherWrapper, _
'               MyDBGridWrapper, _
'               MyDBGridOtherWrapper, _
'               . . .
'       End If

    Me.Form_QueryUnload _
        Form, _
        WrapperCollection()

End Function


Public Function TerminateObject(Object As Variant) As Boolean
Attribute TerminateObject.VB_Description = "Terminates an object from VBOF and the databse"
' Cleans-up while an object is being terminated.
'
' Programming Example:
'   Private Sub Class_Terminate()
'       If Not ObjectManager Is Nothing Then
'           ObjectManager.TerminateObject _
'               Object:=Me
'       End If

    Me.RemoveObject _
        Object:=Object, _
        NoDelete:=True, _
        CleanUpMode:=False

End Function

Public Function TriggerObjectEvent(Optional Event As Variant, Optional Object As Variant, Optional Verbose As Variant) As Boolean
Attribute TriggerObjectEvent.VB_Description = "Triggers an object event"
' Pass-through to the EventManager

#If NoEventMgr = False Then
    TriggerObjectEvent = _
        pvtVBFWEventManager. _
            TriggerObjectEvent( _
                Event:=Event, _
                Object:=Object, _
                Verbose:=Verbose)
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .TriggerObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    TriggerObjectEvent = True
End Function

Public Function TriggerCollectionEvent(Optional Event As Variant, Optional Object As Variant, Optional Collection As Variant, Optional Verbose As Variant, Optional NoDelete As Variant) As Boolean
Attribute TriggerCollectionEvent.VB_Description = "Private"
' Pass-through to the EventManager

#If NoEventMgr = False Then
    pvtVBFWEventManager. _
        TriggerCollectionEvent _
            Event:=Event, _
            Object:=Object, _
            Collection:=Collection, _
            Verbose:=Verbose, _
            NoDelete:=NoDelete
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .TriggerCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    TriggerCollectionEvent = True
End Function


Public Function UnRegisterForAllEvents(Optional RegisterObject As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute UnRegisterForAllEvents.VB_Description = "Private"
' Unregisters the UnregisterObject from all
'   events
'   (a wrapper method for
'       Me.UnRegisterForCollectionEvent and
'       Me.UnRegisterForObjectEvent

    Dim tempCleanUpMode As Boolean

    If IsMissing(CleanUpMode) Then
        tempCleanUpMode = False
    Else
        tempCleanUpMode = CleanUpMode
    End If

#If NoEventMgr = False Then
    Me.UnRegisterForCollectionEvent _
        RegisterObject:=RegisterObject, _
        CleanUpMode:=tempCleanUpMode

    Me.UnRegisterForObjectEvent _
        RegisterObject:=RegisterObject, _
        CleanUpMode:=tempCleanUpMode
#End If
End Function

Public Function UnRegisterForObjectEvent(Optional RegisterObject As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute UnRegisterForObjectEvent.VB_Description = "Private"
' UnRegister the Object for Events

' don't bother doing this during "CleanUpMode"
'   because ObjectManager is being killed, anyway
    If Not IsMissing(CleanUpMode) Then
        If CleanUpMode Then
            UnRegisterForObjectEvent = True
            Exit Function
        End If
    End If

#If NoEventMgr = False Then
    pvtVBFWEventManager. _
        UnRegisterForObjectEvent _
            RegisterObject:=RegisterObject
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .UnRegisterForObjectEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    UnRegisterForObjectEvent = True
End Function


Public Function Version() As String
Attribute Version.VB_Description = "Returns the current version of VBOF"
    Version = "1.0a"
End Function

Public Function VersionDate() As String
Attribute VersionDate.VB_Description = "Returns the current version date of VBOF"
    VersionDate = "1996-01-01"
End Function


Private Sub Class_Initialize()

#If NoEventMgr = False Then
    Set pvtVBFWEventManager = _
        New VBOFEventManager
    Set pvtVBFWEventManager. _
        ObjectManager = Me
#End If

    Set pvtDatabase = Nothing

    pvtSynchronousCommit = False
    pvtDebugMode = False
    pvtVerbose = False
    AutoDeleteOrphans = False
    pvtObjectWasUnique = False
    pvtVBOFCollectionID = 0
    HighestObjectID = 0
    ANSISQL = False
    ODBCPassThrough = False

End Sub



Public Property Get ObjectEventManager() As Variant
Attribute ObjectEventManager.VB_Description = "Private"
' Returns my pvtEventManager

#If NoEventMgr = False Then
    Set ObjectEventManager = pvtVBFWEventManager
#Else
    Set ObjectEventManager = Nothing
#End If
End Property

Private Function pvtFreeObject(Optional Object As Variant, Optional Index As Variant) As Boolean
' Free the Object and remove it from the collection
'   of known system objects

    On Local Error Resume Next

    If Not IsMissing(Index) Then
        pvtSystemObjects.Remove Index
    Else
        pvtSystemObjects.Remove _
            pvtObjectIndexInSystemObjects(Object:=Object)
    End If

    Set Object = Nothing
    pvtFreeObject = True
End Function



Private Function pvtCommitObjects() As Boolean
' NOT CURRENTLY SUPPORTED
'
' Coordinates a synchronous database Commit across
'   all currently instantiated objects.
' Returns True or False, depending on whether or not
'   the Commit was successful (False means that a
'   Rollback has been issued)
' Note: requires use of SynchronousCommit:=True
'   in a parameter to VBOFObjectManager

    Dim tempVBOFCollection As VBOFCollection

' bullet-proofing
    If pvtSynchronousCommit = False Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.CommitObjects' method because the 'SynchronousCommit' environment does not exist.  Execute 'ObjectManager.SynchronousCommit = True'to establish the correct environment."
        pvtCommitObjects = False
        Exit Function
    End If

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " Starting 'CommitObjects' processing."
    End If
#End If

' start the transaction
    pvtWorkspace.BeginTrans

' process each VBOFCollection
    For Each tempVBOFCollection In pvtSystemCollections

' have each commit
        If Not tempVBOFCollection.Commit Then
            pvtWorkspace.Rollback
            pvtCommitObjects = False
            Exit Function
        End If
    Next tempVBOFCollection

' commit the transaction
    pvtWorkspace.CommitTrans

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'CommitObjects' finished successfully."
    End If
#End If

    pvtCommitObjects = True
    Exit Function
End Function

Public Property Set Database(aDatabase As Database)
Attribute Database.VB_Description = "Sets the Database property"
    Set pvtDatabase = aDatabase

#If NoDebugMode = False Then
    If DebugMode Then
        DisplayDebugMessage _
            TypeName(Me) & " 'Database' set to " & TypeName(aDatabase)
    End If
#End If

End Property

Public Property Get Workspace() As Workspace
Attribute Workspace.VB_Description = "Maps to the Workspace property"
    Set Workspace = pvtWorkspace
End Property

Public Property Set Workspace(aWorkspace As Workspace)
    Set pvtWorkspace = aWorkspace
End Property

Public Function EmptyCollection(Optional Collection As Variant, Optional NoDelete As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute EmptyCollection.VB_Description = "Private"
' Empty the VBOFCollection of all its Objects.
'
' Note: if a DataSource is supporting the Collection
'   then the VBOF automatic containment links to
'   the contained objects are also severed

    Dim tempIndex As Long
    Dim tempVBOFCollection As VBOFCollection
    Dim tempObject As Object
    Dim I As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Collection) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.EmptyCollection' method for this object because the 'Collection:=' parameter is missing"
        EmptyCollection = False
        Exit Function
    End If

' free all of its referenced Objects
    For I = 1 To Collection.Count

        Set tempObject = Collection.Item(I)

#If NoDebugMode = False Then
        If DebugMode Then
            DisplayDebugMessage _
                TypeName(Me) & " 'RemoveCollection' is removing the Collection.ObjectID=" & _
                tempObject.ObjectID
        End If
#End If

        RemoveObject _
            Object:=tempObject, _
            Parent:=Collection, _
            NoDelete:=NoDelete, _
            CleanUpMode:=CleanUpMode

    Next I

    EmptyCollection = True
End Function

Public Property Let DebugMode(aBoolean As Boolean)
Attribute DebugMode.VB_Description = "Maps to the DebugMode property"
    pvtDebugMode = aBoolean

#If NoDebugMode = False Then
    If pvtDebugMode Then
        DisplayDebugMessage TypeName(Me) & " starting debug mode"
    End If
#Else
    If aBoolean Then
        DisplayErrorMessage TypeName(Me) & " (Warning) DebugMode has been requested, but the conditional compilation parameter 'NoDebugMode = -1' has been specified.  No debug code is generated unless 'NoDebugMode = 0' or 'NoDebug' is missing from the conditional compilation string altogether."
    End If
#End If
End Property

Public Property Get DebugMode() As Boolean
    DebugMode = pvtDebugMode
End Property


Public Property Get Verbose() As Boolean
Attribute Verbose.VB_Description = "Maps to the Verbose property"
    Verbose = pvtVerbose
End Property
Public Property Let Verbose(aBoolean As Boolean)
    pvtVerbose = aBoolean
End Property


Private Property Get pvtSynchronousCommit()
' NOT CURRENTLY SUPPORTED
'
' Return the current state of the
'   SynchronousCommit environment (True or False)

'    SynchronousCommit = pvtSynchronousCommit
End Property

Private Property Let pvtSynchronousCommit(aBoolean)
' NOT CURRENTLY SUPPORTED
'
' Set the SynchronousCommit environment to aBoolean

'#If NoDebugMode = False Then
'    If DebugMode Then
'        DisplayDebugMessage _
'            TypeName(Me) & " 'SynchronousCommit' mode has been set to " & aBoolean
'    End If
'#End If

'    pvtSynchronousCommit = aBoolean
End Property

Public Function UnRegisterForCollectionEvent(Optional RegisterObject As Variant, Optional CleanUpMode As Variant) As Boolean
Attribute UnRegisterForCollectionEvent.VB_Description = "Private"
' UnRegister the Collection for Events

' don't bother doing this during "CleanUpMode",
'   because ObjectManager is being killed, anyway
    If Not IsMissing(CleanUpMode) Then
        If CleanUpMode Then
            UnRegisterForCollectionEvent = True
            Exit Function
        End If
    End If

#If NoEventMgr = False Then
    pvtVBFWEventManager. _
        UnRegisterForCollectionEvent _
            RegisterObject:=RegisterObject, _
            CleanUpMode:=CleanUpMode
#Else
    If Verbose Then
        DisplayErrorMessage TypeName(Me) & " (Warning) the .UnRegisterForCollectionEvent method has been executed, but the conditional compilation parameter 'NoEventMgr = -1' has been specified.  No Event code is generated unless 'NoEventMgr = 0' or 'NoEventMgr' is missing from the conditional compilation string altogether."
    End If
#End If

    UnRegisterForCollectionEvent = True
End Function



Public Property Get AutoDeleteOrphans() As Boolean
Attribute AutoDeleteOrphans.VB_Description = "Maps to the AutoDeleteOrphans property"
    AutoDeleteOrphans = pvtAutoDeleteOrphans
End Property

Public Property Let AutoDeleteOrphans(aBoolean As Boolean)
    pvtAutoDeleteOrphans = aBoolean
End Property




Private Sub Class_Terminate()
#If NoEventMgr = False Then
    Set pvtVBFWEventManager = Nothing
#End If

    Set pvtSystemCollections = Nothing
    Set pvtSystemObjects = Nothing
    Set pvtSystemObjectsDictionary = Nothing
    Set pvtSystemObjectsDictionaryCollection = Nothing
End Sub