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

Text File | 1996-11-20 | 125.6 KB | 4,001 lines

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

' (c) Copyright 1995 Ken Fitzpatrick
'     All Rights Reserved
'     Cannot be distributed or sold without permission
'
' VBObjectFrameworkCollection is a database-aware
'     Collection class supplemental for Microsoft
'     Visual Basic 4.0.
' This version of VBOFCollection is intended only
'     to be used in conjunction with the following
'     Class Modules:
'       VBOFObjectManager (required)
'       VBOFEventManager  (optional, see comments in VBOFObjectManager for details)
'       VBOFEventObject   (optional, see comments in VBOFObjectManager for details)
' and cannot be used in a "stand-alone" mode, that
'   is, without the support of the above required
'   Class Modules nor can this version be used as
'   the application program's initial point of
'   contact with the VBObjectFramework (the required
'   initial point of contace must be the
'   VBOFObjectManager)
'

Public ObjectID As Long

Private pvtCollection As Collection

Private pvtVBOFObjectManager As VBOFObjectManager
Private pvtVBOFListBoxWrapper As VBOFListBoxWrapper

Private pvtSample As Object
Private pvtParent As Object
Private pvtMostRecentlyAddedObject As Object
Private pvtSampleTableName As String
Private pvtSampleType As String
Private pvtParentTableName As String
Private pvtParentType As String
Private pvtListBox As Variant
Private pvtDBGrid As Variant
Private pvtNewIndex As Long

Private pvtDatabase As Database
Private pvtRecordSet As RecordSet
Private pvtSQLStatement As String
Private pvtWhereClause As String
Private pvtOrderByClause As String
Private pvtCollectionEmulationMode As Boolean
Private pvtRecordSetProvidedByUser As Boolean
Private pvtSQLStatementProvidedByUser As Boolean
Private pvtDBHasBeenReferenced As Boolean
Private pvtANSISQL As Boolean
Private pvtODBCPassThrough As Long
Private pvtDBGridBookmarkArray() As Variant
Private pvtDBGridBookmarkArrayAvailable As Boolean
Private pvtAutoDeleteOrphans As Boolean
Private pvtAutoDeleteOrphansHasBeenInitialized As Boolean
Private RC As Long

Private Const pvtReceiverDoesNotSupportThisMethod = 438

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

Public Property Get AutoDeleteOrphans() As Boolean
    If pvtAutoDeleteOrphansHasBeenInitialized Then
        AutoDeleteOrphans = _
            pvtAutoDeleteOrphans
    Else
        AutoDeleteOrphans = _
            pvtVBOFObjectManager.AutoDeleteOrphans
    End If
End Property


Public Function pvtEmptyCollection(Optional NoDelete As Variant, Optional CleanUpMode As Variant) As Boolean
' Empties this 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

    On Local Error Resume Next

    pvtEmptyCollection = _
        ObjectManager. _
            EmptyCollection( _
                Collection:=Me, _
                NoDelete:=NoDelete, _
                CleanUpMode:=CleanUpMode)

End Function

Public Function pvtCloseRecordSet() As Long
' Closes the current RecordSet.  This might be
'   useful if using the VBOFCollection to
'   populate a ListBox or Grid.
' Returns the VB Err code associated with closing
'   the RecordSet.
' Note: this method should be used with caution.

    On Local Error Resume Next

    pvtRecordSet.Close

    pvtCloseRecordSet = Err
End Function


Public Function PopulateCollection(Optional Database As Variant, Optional RecordSet 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 VBOFCollection
Attribute PopulateCollection.VB_Description = "Populates the VBOFCollection either from the Database, or from a user-provided ResordSet"
' Returns a populated VBOFCollection.
'   Serves a purpose of simplification for the
'   user.  This method gives the user a single
'   method to invoke for instantiating the
'   VBOFCollection, regardless of whether
'   the "pvtPopulateFromDatabase" method or
'   the "pvtPopulateFromRecordSet" method is
'   actually used.
'
' Either Database:= or RecordSet:= must be provided.
'   For RecordSet:= support, the caller must have
'       independently created the RecordSet object.
'   Otherwise, the Database:= parameter should be
'       specified and VBOFCollection will create
'       the underlying RecordSet automatically
'
' Parameter Description:
'   see VBOFObjectManager.ManageCollection

' bullet-proofing
'    If IsMissing(Database) _
'    And IsMissing(RecordSet) Then
    If IsMissing(RecordSet) _
    And pvtDatabase Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.PopulateCollection' method because both the 'Database:=' and 'RecordSet:=' parameter are missing."
        Set PopulateCollection = Me
        Exit Function
    End If

    If Not IsMissing(RecordSet) Then
        Set PopulateCollection = _
            pvtPopulateFromRecordSet( _
                RecordSet:=RecordSet, _
                Parent:=Parent, _
                Sample:=Sample, _
                SQL:=SQL, _
                ANSISQL:=ANSISQL, _
                WhereClause:=WhereClause, _
                OrderByClause:=OrderByClause, _
                ODBCPassThrough:=ODBCPassThrough)
    Else
        Set PopulateCollection = _
            pvtPopulateFromDatabase( _
                Database:=Database, _
                Parent:=Parent, _
                Sample:=Sample, _
                SQL:=SQL, _
                ANSISQL:=ANSISQL, _
                WhereClause:=WhereClause, _
                OrderByClause:=OrderByClause, _
                ODBCPassThrough:=ODBCPassThrough)
    End If

End Function

Public Function pvtDataValidate(Optional DataControl As Variant, Optional Action As Variant, Optional Save As Variant, Optional Sample As Variant, Optional Parent As Variant) As Variant

    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Action) Then
        Set pvtDataValidate = Nothing
        Exit Function
    End If
    If IsMissing(Save) Then
        Set pvtDataValidate = Nothing
        Exit Function
    End If

    If Not pvtSetSample( _
            Sample:=Sample, _
            MethodName:="pvtDataValidate") Then
        Set pvtDataValidate = Nothing
        GoTo pvtDataValidate_Exit
    End If
    If Not pvtSetParent( _
            Parent:=Parent, _
            MethodName:="pvtDataValidate") Then
        Set pvtDataValidate = Nothing
        Exit Function
    End If

' process according to Action
    Select Case Action

' process Action=AddNew
        Case vbDataActionAddNew

' instantiate a new object
            Set tempObject = _
                ObjectManager. _
                    pvtInstantiateNewObjectFromSample _
                        (Sample:=pvtSample)
            If tempObject Is Nothing Then
                Set pvtDataValidate = Nothing
                Exit Function
            End If

' have the new instantiated object copy populate
'   itself from this RecordSet row
            Set tempObject = _
                ObjectManager. _
                    pvtObjectInitializeFromRecordSet( _
                        Object:=tempObject, _
                        RecordSet:=pvtRecordSet)
            If tempObject Is Nothing Then
                Set pvtDataValidate = Nothing
                Exit Function
            End If

' add the new object to Me.RecordSet
            Set tempObject = _
                Me.Add( _
                    Item:=tempObject)

            Set DataControl.RecordSet = _
                pvtRecordSet

' process Action=Update
        Case vbDataActionUpdate

' get the object at the RecordSet row
            Set tempObject = _
                pvtRecordSetMoveToRecordNumber _
                    (pvtRecordSet.AbsolutePosition)

' have the new instantiated object copy populate
'   itself from this RecordSet row
            Set tempObject = _
                ObjectManager. _
                    pvtObjectInitializeFromRecordSet( _
                        Object:=tempObject, _
                        RecordSet:=pvtRecordSet)
            If tempObject Is Nothing Then
                Set pvtDataValidate = Nothing
                Exit Function
            End If

' update the object in the Collection
            Replace _
               Item:=tempObject, _
               ReplaceWith:=tempObject

' process Action=Delete
        Case vbDataActionDelete

' get the object at the RecordSet row
            Set tempObject = _
                pvtRecordSetMoveToRecordNumber _
                    (pvtRecordSet.AbsolutePosition)

' remove the object from the Collection
            Remove _
                Item:=tempObject, _
                NoDelete:=True

        End Select

pvtDataValidate_Exit:
    Set pvtDataValidate = tempObject
    Set tempObject = Nothing
End Function


Private Function pvtIsAnOrphan(Optional Item As Variant) As Boolean
' Determines whether or not the Item is an Orphan

    Dim tempCountOfParentLinksToItem As Long

' count the number of Parent objects which currently
'   reference Item
    tempCountOfParentLinksToItem = _
        pvtCountOfParentLinksToItem( _
           Child:=Item, _
           Parent:=pvtParent)

    If tempCountOfParentLinksToItem > 0 Then
        pvtIsAnOrphan = False
    Else
        pvtIsAnOrphan = True
    End If
End Function


Public Function ObjectDataSource() As String
Attribute ObjectDataSource.VB_Description = "Private"
    ObjectDataSource = "VBObjectFrameworkObjectLinks"
End Function

Private Function pvtAddUniqueItemToCollection(Optional Item As Variant, Optional Parent As Variant, Optional Collection As Variant) As Variant
' Add the Item to the Collection, if it is unique.
' Return the object which is actually added to
'   the Collection

    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Item) _
    Or IsMissing(Parent) _
    Or IsMissing(Collection) Then
        Set pvtAddUniqueItemToCollection = Nothing
        Exit Function
    End If

' verify that the object is unique across
'   the known system objects
    Set tempObject = _
        pvtVBOFObjectManager. _
            AddUniqueObject( _
                Object:=Item, _
                Parent:=Parent)

' add the object to the collection
    Collection.Add _
        Item:=tempObject, _
        Key:=CStr(tempObject.ObjectID)

' add the reference to the pvtDBGridBookmarkArray
    pvtAddItemToDBGridArray _
        Item:=tempObject, _
        Collection:=Collection

' return the unique object
    Set pvtAddUniqueItemToCollection = _
        tempObject
End Function

Private Function pvtCollectionIndexForWhereClause(Optional WhereClause As Variant, Optional FindFirst As Variant, Optional FindNext As Variant, Optional FindLast As Variant, Optional FindPrevious As Variant) As Variant
' Returns the next object in the collection which
'   meets the criteria of the WhereClause.
' Note: processing is based on the RecordSet, thus
'   positioning is relative to the positioning of
'   the underlying RecordSet.  See also methods
'   "RecordSet" and "pvtRecordSetMoveFirst"
' Parameters:
'   WhereClause - a search string which can be
'       appended to the RecordSet.FindNext method
'   FindFirst - a boolean which determines whether
'       the FindNext or FindFirst method should be
'       used

    Dim tempFindFirst As Boolean
    Dim tempFindNext As Boolean
    Dim tempFindLast As Boolean
    Dim tempFindPrevious As Boolean
    Dim tempObjectID As Long
    Dim I As Long
    Dim tempObject As Variant

    On Local Error Resume Next

    tempFindNext = True

' bullet-proofing
    If pvtRecordSet Is Nothing Then
        pvtCollectionIndexForWhereClause = -1
        GoTo pvtCollectionIndexForWhereClause_Exit
    End If
    If pvtCollection.Count <= 0 Then
        pvtCollectionIndexForWhereClause = -1
        GoTo pvtCollectionIndexForWhereClause_Exit
    End If
    If pvtCollection(1).ObjectDataSource = "" Or Err = 438 Then
        pvtCollectionIndexForWhereClause = -1
        GoTo pvtCollectionIndexForWhereClause_Exit
    End If

' set FindFirst
    tempFindFirst = False
    If Not IsMissing(FindFirst) Then
        tempFindFirst = FindFirst
    End If

' set FindLast
    tempFindLast = False
    If Not IsMissing(FindLast) Then
        tempFindLast = FindLast
    End If

' set FindPrevious
    tempFindPrevious = False
    If Not IsMissing(FindPrevious) Then
        tempFindPrevious = FindPrevious
    End If

' search for the next qualifying row in the RecordSet
    If tempFindPrevious Then
        pvtRecordSet.FindPrevious WhereClause
    ElseIf tempFindLast Then
        pvtRecordSet.FindLast WhereClause
    ElseIf tempFindFirst Then
        pvtRecordSet.FindFirst WhereClause
    Else
        pvtRecordSet.FindNext WhereClause
    End If

    If pvtRecordSet.NoMatch Then
        pvtCollectionIndexForWhereClause = -1
        GoTo pvtCollectionIndexForWhereClause_Exit
    End If

' save the ObjectID of the found record
    tempObjectID = pvtRecordSet("ObjectID")

' search for the corresponding object
    I = 1
    For Each tempObject In pvtCollection
        If tempObject.ObjectID = tempObjectID Then
            pvtCollectionIndexForWhereClause = I
            GoTo pvtCollectionIndexForWhereClause_Exit
        End If

        I = I + 1
    Next tempObject

    pvtCollectionIndexForWhereClause = -1

pvtCollectionIndexForWhereClause_Exit:
    Set tempObject = Nothing

End Function


Public Function pvtDBGridUnboundReadData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional StartLocation As Variant, Optional ReadPriorRows As Variant) As Long
' Populates the DBGrid with one row of information
'   for each object in this VBOFCollection.
' Returns the number of rows added to the DBGrid
' Note:  the referenced objects must contain the
'   method 'ObjectDBGridValue', which must populate
'   and return the RowBuffer object
'   (for more information, find "RowBuffer" in the
'   online VB Help.)
'
' Note:  this method should be coded in the
'   DBGrid's UnboundReadData Event Procedure,
'   as follows:
'
'   Private Sub DBGrid1_UnboundReadData(ByVal RowBuf As RowBuffer, StartLocation As Variant, ByVal ReadPriorRows As Boolean)
'       MyVBOFCollection.pvtDBGridUnboundReadData _
'           DBGrid:=DBGrid1, _
'           RowBuf:=RowBuf, _
'           StartLocation:=StartLocation, _
'           ReadPriorRows:=ReadPriorRows
'   End Sub

    Dim tempObject As Object
    Dim tempIncrement As Long
    Dim tempCurrentRowIndex As Long
    Dim tempRowIndex As Long
    Dim tempColumnIndex As Long
    Dim tempRowsFetched As Long
    Dim tempBookmark As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Or IsMissing(RowBuf) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridUnboundReadData' method for this object because the 'DBGrid' or 'RowBuf' parameter is missing."
            pvtDBGridUnboundReadData = False
            GoTo pvtDBGridUnboundReadData_Exit
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

    If ReadPriorRows Then
        tempIncrement = -1
    Else
        tempIncrement = 1
    End If

    tempBookmark = StartLocation

' process the row
    tempRowsFetched = 0
    For tempRowIndex = 0 To RowBuf.RowCount - 1

        tempBookmark = _
            pvtDBGridGetRelativeBookmark( _
                tempBookmark, _
                tempIncrement, _
                pvtCollection.Count)

        If IsNull(tempBookmark) Then
            Exit For
        End If

' reference the object associated with the
'   current row, indexed by relative position
'   within the pvtCollection
        Set tempObject = _
            pvtCollection.Item _
                (CLng(tempBookmark) + 1)

' have the object complete the RowBuf
'   with its own Property values
        tempObject.ObjectDBGridUnboundReadData _
            DBGrid:=pvtDBGrid, _
            RowBuf:=RowBuf, _
            RowNumber:=tempCurrentRowIndex

' assign the Bookmark to the row, as returned above.
'   Internally, the CollectionIndex(Object) is used
        RowBuf.Bookmark(tempRowIndex) = _
            tempBookmark

        tempCurrentRowIndex = tempCurrentRowIndex + tempIncrement
        tempRowsFetched = tempRowsFetched + 1

    Next tempRowIndex

pvtDBGridUnboundReadData_Exit:
    Set tempObject = Nothing
    RowBuf.RowCount = tempRowsFetched
    pvtDBGridUnboundReadData = tempRowsFetched
End Function

Public Function pvtDBGridUnboundAddData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional NewRowBookmark As Variant, Optional Sample As Variant, Optional Parent As Variant) As Variant
' Processes the UnboundAddData event of the DBGrid.
'   Automatically instantiates a new object,
'   populates it, adds it to the VBOFCollection
'   and returns the VBOFCollection to the
'   application.
'
' Parameters:
'   DBGrid:= identifies the DBGrid
'   RowBuf:= is the same RowBuf parameter found
'       in the application's UnboundAddData event
'       handler
'   NewRowBookmark:= is the same NewRowBookmark
'       parameter found in the application's
'       UnboundAddData event handler
'   Sample:= (Optional) identifies the class
'       type to instantiate with the new data.
'       If a previous VBOFCollection method had
'       already established a Sample:=, this
'       parameter can be eliminated
'   Parent:= (Optional) identifies the object
'       which is the parent ("container") object of
'       the objects in this collection.
'       If a previous VBOFCollection method had
'       already established a Parent:=, this
'       parameter can be eliminated
'
' Note:  this method should be coded as follows:
'   Private Sub DBGrid1_UnboundAddData(ByVal RowBuf As RowBuffer, NewRowBookmark As Variant)
'       MyVBOFCollection.pvtDBGridUnboundAddData _
'           DBGrid:=DBGrid1, _
'           RowBuf:=RowBuf, _
'           NewRowBookmark:=NewRowBookmark
'
' or,
'       Dim tempSample as New MyClass
'       MyVBOFCollection.pvtDBGridUnboundAddData _
'           DBGrid:=DBGrid1, _
'           RowBuf:=RowBuf, _
'           NewRowBookmark:=NewRowBookmark, _
'           Sample:=tempSample
'   End Sub

    Dim tempNewObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) _
    Or IsMissing(RowBuf) _
    Or IsMissing(NewRowBookmark) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridUnboundAddData' method for this object because the 'DBGrid', 'RowBuf' or 'NewRowBookmark' parameter is missing."
            Set pvtDBGridUnboundAddData = Nothing
            GoTo pvtDBGridUnboundAddData_Exit
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If
    If Not pvtSetSample( _
            Sample:=Sample, _
            MethodName:="pvtDBGridUnboundAddData") Then
        Set pvtDBGridUnboundAddData = Nothing
        GoTo pvtDBGridUnboundAddData_Exit
    End If
    If Not pvtSetParent( _
            Parent:=Parent, _
            MethodName:="pvtDBGridUnboundAddData") Then
        Set pvtDBGridUnboundAddData = Nothing
        GoTo pvtDBGridUnboundAddData_Exit
    End If

' instantiate the new object
    Set tempNewObject = _
        ObjectManager. _
            pvtInstantiateNewObjectFromSample _
                (Sample:=pvtSample)
    If tempNewObject Is Nothing Then
        GoTo pvtDBGridUnboundAddData_Exit
    End If

' have the object populate the object from
'   the new row
    If tempNewObject. _
        ObjectDBGridUnboundAddData( _
            DBGrid:=pvtDBGrid, _
            RowBuf:=RowBuf, _
            NewRowBookmark:=NewRowBookmark) Then

' add the object to the collection and Database,
'   if applicable
        Add _
            Item:=tempNewObject, _
            After:=pvtCollection.Count
    End If

pvtDBGridUnboundAddData_Exit:
    Set tempNewObject = Nothing
    Set pvtDBGridUnboundAddData = Me
End Function

Public Function pvtDBGridUnboundWriteData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional WriteLocation As Variant) As Variant
' Processes the UnboundWriteData event of the DBGrid.
'
' Parameters:
'   DBGrid:= identifies the DBGrid
'   RowBuf:= is the same RowBuf parameter found
'       in the application's UnboundWriteData event
'       handler
'   WriteLocation:= is the same WriteLocation
'       parameter found in the application's
'       UnboundWriteData event handler
'
' Note:  this method should be coded as follows:
'   Private Sub DBGrid1_UnboundWriteData(Optional RowBuf As Variant, Optional WriteLocation As Variant)
'       MyVBOFCollection.pvtDBGridUnboundWriteData _
'           DBGrid:=DBGrid1, _
'           RowBuf:=RowBuf, _
'           WriteLocation:=WriteLocation
'   End Sub

    Dim tempObjectID As Long
    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(RowBuf) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundWriteData' method for this object because the 'RowBuf:=' parameter is missing."
        Set pvtDBGridUnboundWriteData = Nothing
        GoTo pvtDBGridUnboundWriteData_Exit
    End If
    If IsMissing(WriteLocation) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundWriteData' method for this object because the 'WriteLocation:=' parameter is missing."
        Set pvtDBGridUnboundWriteData = Nothing
        GoTo pvtDBGridUnboundWriteData_Exit
    End If
    If IsMissing(DBGrid) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridUnboundAddData' method for this object because the 'DBGrid' parameter is missing."
            Set pvtDBGridUnboundWriteData = Nothing
            GoTo pvtDBGridUnboundWriteData_Exit
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

' position to the correct object
    Set tempObject = _
        pvtCollection.Item _
            (CollectionIndex _
                (Key:=pvtDBGridObjectIDAtBookmark _
                    (WriteLocation)))

    If tempObject Is Nothing Then
        Set pvtDBGridUnboundWriteData = Nothing
        GoTo pvtDBGridUnboundWriteData_Exit
    End If

' have the object populate the object from
'   the DBGrid row
    tempObject. _
        ObjectDBGridUnboundAddData _
            DBGrid:=pvtDBGrid, _
            RowBuf:=RowBuf, _
            NewRowBookmark:=WriteLocation
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(tempObject) & "' does not support the method 'ObjectDBGridUnboundAddData'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
        GoTo pvtDBGridUnboundWriteData_Exit
    End If

' update the object in the Collection
     Replace _
        Item:=tempObject, _
        ReplaceWith:=tempObject

pvtDBGridUnboundWriteData_Exit:
    Set tempObject = Nothing
    Set pvtDBGridUnboundWriteData = Me
End Function

Public Function pvtDBGridUnboundDeleteRow(Optional DBGrid As Variant, Optional Bookmark As Variant) As Variant
' Processes the UnboundDeleteRow event of the
'   DBGrid.
'
' Parameters:
'   DBGrid:= identifies the DBGrid
'   Bookmark:= is the same Bookmark parameter found
'       in the application's UnboundDeleteRow event
'       handler
'
' Note:  this method should be coded as follows:
'   Private Sub DBGrid1_UnboundDeleteRow(Optional Bookmark As Variant)
'       MyVBOFCollection.UnboundDeleteRow _
'           DBGrid:=DBGrid1, _
'           Bookmark:=Bookmark
'   End Sub

    Dim tempObjectID As Long
    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Bookmark) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundDeleteRow' method for this object because the 'Bookmark:=' parameter is missing."
        Set pvtDBGridUnboundDeleteRow = Nothing
        GoTo pvtDBGridUnboundDeleteRow_Exit
    End If
    If IsMissing(DBGrid) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridUnboundAddData' method for this object because the 'DBGrid' parameter is missing."
            Set pvtDBGridUnboundDeleteRow = Nothing
            GoTo pvtDBGridUnboundDeleteRow_Exit
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

' position to the correct object
    Set tempObject = _
        pvtCollection.Item _
            (CollectionIndex _
                (Key:=pvtDBGridObjectIDAtBookmark _
                    (Bookmark)))

    If tempObject Is Nothing Then
        Set pvtDBGridUnboundDeleteRow = Nothing
        GoTo pvtDBGridUnboundDeleteRow_Exit
    End If

' remove the object from the Collection
    Remove _
        Item:=tempObject, _
        NoDelete:=True

pvtDBGridUnboundDeleteRow_Exit:
    Set tempObject = Nothing
    Set pvtDBGridUnboundWriteData = Me
End Function

Public Function pvtDBGridSetNumberOfRows(Optional DBGrid As Variant) As Boolean
' Informs the DBGrid of the number of rows that
'   are to be added
' Note:  the referenced objects must contain the
'   method 'ObjectDBGridValue', which must populate
'   and return the RowBuffer object
'   (for more information, find "RowBuffer" in the
'   online VB Help.)
'
' Note:  this method should be coded as follows:
'   Private Sub Form_Load()
'       MyVBOFCollection.pvtDBGridSetNumberOfRows _
'           DBGrid=MyDBGrid
'   End Sub

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridSetNumberOfRows' method for this object because the 'DBGrid' parameter is missing."
            pvtDBGridSetNumberOfRows = False
            Exit Function
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

    pvtDBGrid.RowBuffer.RowCount = _
        pvtCollection.Count

End Function

Public Property Get pvtDBGridBookmark(DBGrid As Variant) As Variant
' Returns the Bookmark value of the DBGrid
' Using this method:
'       myObjectID = _
'           MyCollection.pvtDBGridBookmark _
'               (DBGrid1)

    Dim tempBookmark As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridBookmark' method for this object because the 'DBGrid' parameter is missing."
            pvtDBGridBookmark = -1
            Exit Property
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

    tempBookmark = _
        pvtDBGrid.Bookmark

    If Err = 0 Then
        pvtDBGridBookmark = _
            tempBookmark
    Else
        pvtDBGridBookmark = Null
    End If

End Property

Public Property Let pvtDBGridBookmark(DBGrid As Variant, Bookmark As Variant)
' Sets the Bookmark value of the DBGrid
' Using this method:
'       MyCollection.pvtDBGridBookmark _
'           (DBGrid1) = MyBookMark

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Or IsMissing(Bookmark) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridBookmark' method for this object because the 'DBGrid' or 'Bookmark' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

    pvtDBGrid.Bookmark = Bookmark

End Property


Public Property Get pvtDBGridBookmarkObject(DBGrid As Variant) As Variant
' Returns the Object at the Bookmark value of the
'   DBGrid
' Using this method:
'       MyObject = _
'           MyCollection.pvtDBGridBookmarkObject _
'               (DBGrid1)

    Dim tempBookmark As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridBookmarkObject' method for this object because the 'DBGrid' parameter is missing."
            Set pvtDBGridBookmarkObject = Nothing
            Exit Property
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

    tempBookmark = _
        pvtDBGridBookmark(pvtDBGrid)

' translate the Bookmark into an Item in the
'   Collection
    If Not IsNull(tempBookmark) Then
        Set pvtDBGridBookmarkObject = ( _
            pvtCollection.Item( _
                CollectionIndex( _
                    Key:=pvtDBGridObjectIDAtBookmark _
                        (tempBookmark))))
    Else
        Set pvtDBGridBookmarkObject = _
            Nothing
    End If

End Property

Public Property Set pvtDBGridBookmarkObject(DBGrid As Variant, Object As Variant)
' Sets the Bookmark of the DBGrid to the position
'   of Object
' Using this method:
'       Set MyCollection.pvtDBGridBookmarkObject _
'           (DBGrid1) = MyObject

    Dim tempLong As Long
    Dim tempBookmark As Variant
    Dim tempRow As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(DBGrid) Or IsMissing(Object) Then
        If pvtDBGrid Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtDBGridBookmarkObject' method for this object because the 'DBGrid' or 'Object' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtDBGrid = DBGrid
    End If

' translate Object.ObjectID to a Bookmark
    tempLong = Object.ObjectID
    If tempLong >= 0 Then
        tempRow = _
            pvtDBGridRowIndexAtObjectID( _
                CStr(tempLong))

        pvtDBGrid.Row = tempRow

        pvtDBGrid.Bookmark = _
            pvtDBGridBookmarkAtRowIndex _
                (tempRow)
    End If
End Property


Public Property Get pvtListBoxListIndex(ListBox As Variant) As Long
' Returns the ListBox's ListIndex
' Note:  this method should be used as follows:
'       MyListIndex = _
'           MyVBOFCollection.pvtListBoxListIndex _
'               (MyListBox)

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxListIndex' method for this object because the 'ListBox' or 'ListIndex' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    pvtListBoxListIndex = _
        pvtListBox.ListIndex

End Property


Public Property Let pvtListBoxListIndex(ListBox As Variant, ByVal ListIndex As Long)
' Sets the ListBox's ListIndex
' Note:  this method should be used as follows:
'       MyVBOFCollection.pvtListBoxListIndex _
'               (MyListBox) = MyListIndex

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Or IsMissing(ListIndex) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxListIndex' method for this object because the 'ListBox' or 'ListIndex' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    If pvtListBox.ListCount > 0 _
    And pvtListBox.ListCount >= ListIndex Then
        pvtListBox.ListIndex = ListIndex
    Else
        pvtListBox.ListIndex = -1
    End If

End Property

Public Property Get pvtComboBoxText(ComboBox As Variant) As String
' Returns the ComboBox's Text property
' Note:  this method should be used as follows:
'       MyString = _
'           MyVBOFCollection.pvtComboBoxText (ComboBox1)

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ComboBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtComboBoxText' method for this object because the 'ComboBox' parameter is missing."
            pvtComboBoxText = ""
            Exit Property
        End If
    Else
        Set pvtListBox = ComboBox
    End If

    pvtComboBoxText = pvtListBox.Text

End Property

Public Property Let pvtComboBoxText(ComboBox As Variant, Text As String)
' Sets the ComboBox's Text property
' Note:  this method should be used as follows:
'       MyVBOFCollection.pvtComboBoxText (ComboBox1) = _
'           MyString

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ComboBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtComboBoxText' method for this object because the 'ComboBox' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ComboBox
    End If

    pvtListBox.Text = Text

End Property



Public Function pvtListBoxListCount(Optional ListBox As Variant) As Long
' Returns the ListBox's ListCount property
' Note:  this method should be used as follows:
'       MyListCount = _
'           MyVBOFCollection.pvtListBoxListCount (MyListBox)

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxListCount' method for this object because the 'ListBox' parameter is missing."
            pvtListBoxListCount = -1
            Exit Function
        End If
    Else
        Set pvtListBox = ListBox
    End If

    pvtListBoxListCount = pvtListBox.ListCount

End Function

Public Function pvtListBoxRefresh(Optional ListBox As Variant) As Boolean
' Refreshes the display of the ListBox
' Note:  this method should be coded as follows:
'       MyVBOFCollection.pvtListBoxRefresh _
'          MyListBox

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxRefresh' method for this object because the 'ListBox' parameter is missing."
            Set pvtListBoxRemoveItem = False
            Exit Function
        End If
    Else
        Set pvtListBox = ListBox
    End If

' clear and populate the ListBox
    pvtListBoxClear ListBox
    pvtListBoxAddItems ListBox

    pvtListBoxRefresh = True
End Function

Public Property Get pvtListBoxTopIndex(ListBox As Variant) As Long
' Returns the ListBox's TopIndex property
' Note:  this method should be used as follows:
'       MyTopIndex = _
'           MyVBOFCollection.pvtListBoxTopIndex _
'               (MyListBox)

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxTopIndex' method for this object because the 'ListBox' parameter is missing."
            pvtListBoxTopIndex = -1
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    pvtListBoxTopIndex = pvtListBox.TopIndex
End Property

Public Property Let pvtListBoxTopIndex(ListBox As Variant, ListIndex As Long)
' Sets the ListBox's TopIndex property to ListIndex
' Note:  this method should be used as follows:
'     MyVBOFCollection.pvtListBoxTopIndex _
'         (MyListBox) = MyTopIndex

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxTopIndex' method for this object because the 'ListBox' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If
    If IsMissing(ListIndex) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxTopIndex' method for this object because the 'ListIndex' parameter is missing."
        Exit Property
    End If

    pvtListBox.TopIndex = ListIndex
End Property


Public Property Get pvtListBoxTopObject(ListBox As Variant) As Variant
' Returns the Object at the ListBox's TopIndex property
' Note:  this method should be used as follows:
'       Set MyTopObject = _
'           MyVBOFCollection.pvtListBoxTopObject (MyListBox)

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxTopIndex' method for this object because the 'ListBox' parameter is missing."
            Set pvtListBoxTopObject = Nothing
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    Set pvtListBoxTopObject = _
        pvtCollection.Item(pvtListBox.TopIndex + 1)
End Property

Public Property Set pvtListBoxTopObject(ListBox As Variant, Object As Variant)
' Sets the ListBox's TopIndex property to be the
'   index of Object
' Note:  this method should be used as follows:
'       Set MyVBOFCollection. _
'           pvtListBoxTopObject (MyListBox) = _
'               MyTopObject

    Dim tempLong As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxTopIndex' method for this object because the 'ListBox' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    tempLong = _
        CollectionIndex(Item:=Object)

    If tempLong > 0 Then
        pvtListBox.TopIndex = tempLong + 1
    End If
End Property


Public Property Get pvtListBoxListIndexObject(ListBox As Variant) As Variant
' Returns the object at the ListBox's ListIndex
' Note:  this method should be coded as follows:
'   Private Sub MyListBox_Click()
'       Dim MyObject as MyObject
'       MyObject = _
'           MyVBOFCollection.pvtListBoxListIndexObject _
'               (MyListBox)
'   End Sub

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxListIndexObject' method for this object because the 'ListBox' parameter is missing."
            Set pvtListBoxListIndexObject = Nothing
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    If pvtListBox.ListIndex >= 0 _
    And pvtCollection.Count >= pvtListBox.ListIndex + 1 Then
        Set pvtListBoxListIndexObject = _
            pvtCollection.Item(pvtListBox.ListIndex + 1)
    Else
        Set pvtListBoxListIndexObject = Nothing
    End If

End Property

Public Property Set pvtListBoxListIndexObject(ListBox As Variant, Object As Variant)
' Sets the ListBox's ListIndex to correspond to the
'   Object and returns the selected Object
' Note:  this method should be coded as follows:
'   Private Sub MyListBox_Click()
'       Dim MyObject as MyObject
'       Set MyVBOFCollection.pvtListBoxListIndexObject _
'               (MyListBox) = MyObject
'   End Sub

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Or IsMissing(Object) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxListIndexObject' method for this object because the 'ListBox' or 'Object' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    pvtListBox.ListIndex = _
        CollectionIndex(Item:=Object)
End Property


Public Function pvtListBoxAddItems(Optional ListBox As Variant) As Boolean
' Populates the ListBox with one line of information
'   for each object in this VBOFCollection
' Note:  the referenced objects must contain the
'   method 'ObjectListBoxValue', which must return
'   a String which is the text which is to appear
'   in the ListBox and is to represent the object
'   for the purposes of the ListBox.
' Note:  this method should be coded as follows:
'    MyVBOFCollection.pvtListBoxAddItems MyListBox

    Dim tempObject As Object
    Dim tempListBoxText As String
    Dim tempListBox As Variant

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxAddItems' method for this object because the 'ListBox:=' parameter is missing."
            pvtListBoxAddItems = False
            GoTo pvtListBoxAddItems_Exit
        End If
    Else
        Set pvtListBox = ListBox
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has begun '.pvtListBoxAddItems' processing"
    End If
#End If

' .AddItem each object into the ListBox
    For Each tempObject In pvtCollection
        pvtListBox.AddItem _
            tempObject.ObjectListBoxValue()
    Next tempObject

    pvtListBoxAddItems = True
    GoTo pvtListBoxAddItems_Exit

pvtListBoxAddItems_Exit:
    Set tempObject = Nothing
    Set tempListBox = Nothing

End Function

Public Function pvtListBoxClear(Optional ListBox As Variant, Optional NoDelete As Variant) As Boolean
' Empties the objects from the ListBox and removes
'   the corresponding objects from the Collection
' Note:  this method should be coded as follows:
'     MyVBOFCollection.pvtListBoxClear _
'               MyListBox
' Note:
'   In order to actually remove the containment
'       links from the containing object to the
'       items in the ListBox, specify
'       NoDelete:=False

    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxClear' method for this object because the 'ListBox:=' parameter is missing."
            pvtListBoxClear = False
            GoTo pvtListBoxClear_Exit
        End If
    Else
        Set pvtListBox = ListBox
    End If

' clear the ListBox
    pvtListBox.Clear

' .RemoveObject for each object in the Collection
    If Not IsMissing(NoDelete) Then
        If Not NoDelete Then     ' doesn't work when ANDed with line above
            For Each tempObject In pvtCollection
                pvtVBOFObjectManager.RemoveObject _
                    Object:=tempObject, _
                    Parent:=Me, _
                    NoDelete:=NoDelete
            Next tempObject
        End If
    End If

    pvtListBoxClear = True
    GoTo pvtListBoxClear_Exit

pvtListBoxClear_Exit:
    Set tempObject = Nothing
End Function
Public Function pvtListBoxRemoveObject(Optional ListBox As Variant, Optional Object As Variant) As Boolean
' Removes the specified Object from the ListBox
' Note:  this method should be coded as follows:
'       Dim MyUndesiredObject As MyClass
'       MyVBOFCollection.pvtListBoxRemoveObject _
'          MyListBox, MyUndesiredObject

    Dim tempIndex As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'ListBox' parameter is missing."
            pvtListBoxRemoveObject = False
            Exit Function
        End If
    Else
        Set pvtListBox = ListBox
    End If
    If IsMissing(Object) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'Object' parameter is missing."
        pvtListBoxRemoveObject = False
        Exit Function
    End If

' find the Object
    tempIndex = _
        CollectionIndex(Item:=Object)

    If tempIndex <= 0 Then
        pvtListBoxRemoveObject = False
        Exit Function
    End If

' remove the Object from the Collection
    Remove _
        Item:=Object, _
        NoDelete:=True

' remove the Object from the ListBox
    pvtListBox.RemoveItem _
        tempIndex - 1

    pvtListBoxRemoveObject = True
End Function



Public Function pvtListBoxRemoveItem(Optional ListBox As Variant, Optional ListIndex As Variant) As Boolean
' Removes the Object at the specified ListIndex
'   from the ListBox
' Note:  this method should be coded as follows:
'       Dim MyUndesiredListIndex As Long
'       MyVBOFCollection.pvtListBoxRemoveItem _
'          MyListBox, MyUndesiredListIndex

    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'ListBox' parameter is missing."
            pvtListBoxRemoveItem = False
            Exit Function
        End If
    Else
        Set pvtListBox = ListBox
    End If
    If IsMissing(ListIndex) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'ListIndex'  parameter is missing."
        pvtListBoxRemoveItem = False
        Exit Function
    End If

' find the Object
    Set tempObject = _
        pvtCollection.Item(ListIndex + 1)

    If tempObject Is Nothing Then
        pvtListBoxRemoveItem = False
        Exit Function
    End If

' remove the Object from the Collection
    Remove _
        Item:=tempObject, _
        NoDelete:=True

' remove the Object from the ListBox
    pvtListBox.RemoveItem _
        ListIndex

    pvtListBoxRemoveItem = True
    Set tempObject = Nothing
End Function


Public Property Get pvtListBoxSelectedObjects(ListBox As Variant) As Collection
' Returns a collection of the selected objects
'   of the specified ListBox
' Note:  this method should be coded as follows:
'   Private Sub MyListBox_Click()
'       Dim MyCollection As Collection
'       Set MyCollection = _
'           MyVBOFCollection.pvtListBoxSelectedObjects _
'               (MyListBox)
'   End Sub

    Dim tempCollection As New Collection
    Dim tempObject As Object
    Dim I As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectedObjects' method for this object because the 'ListBox' parameter is missing."
            Set pvtListBoxSelectedObjects = Nothing
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

' collect all selected objects
    I = 0
    For Each tempObject In pvtCollection
        If pvtListBox.Selected(I) Then
            tempCollection.Add tempObject
        End If

        I = I + 1
    Next tempObject

    Set pvtListBoxSelectedObjects = tempCollection
    Set tempObject = Nothing
End Property


Public Property Set pvtListBoxSelectedObjects(ListBox As Variant, Collection As Collection)
' Sets the selected objects of the specified
'   ListBox to the contents of Collection
' Note:  this method should be coded as follows:
'       Dim MyCollection As Collection
'       MyVBOFCollection.pvtListBoxSelectedObjects _
'               (MyListBox) = MyCollection

    Dim tempObject As Object
    Dim tempIndex As Long
    Dim I As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Or IsMissing(Collection) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectedObjects' method for this object because the 'ListBox' or 'Collection' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

' unselect any currently selected rows
    For I = 0 To pvtListBox.ListCount - 1
        pvtListBox.Selected(I) = False
    Next I

' select those rows whose corresponding objects
'   appear in Collection
    For Each tempObject In Collection
        tempIndex = _
            CollectionIndex(Item:=tempObject)

        If tempIndex > 0 Then
            pvtListBox.Selected(tempIndex - 1) = True
        End If

    Next tempObject

    Set tempObject = Nothing
End Property




Public Function Add(Optional Item As Variant, Optional Key As Variant, Optional Parent As Variant, Optional After As Variant, Optional NoInsert As Variant) As Variant
Attribute Add.VB_Description = "Add an item to the collection.  Automatically inserts the item into the associated table.  See the VB Programmer's Manual for details"
' Add the new Item to the collection and
'   return the collection.
' Note: Item might be freed by VBOFObjectManager
'   if it is found to be non-unique throughout the
'   environment.  For more information, refer to
'   VBOFObjectManager.AddUniqueObject.

    Dim tempSuppressInsert As Boolean
    Dim tempObject As Object
    Dim tempFoundInFirstPass As Boolean

    On Local Error Resume Next
    Set Add = Me

' bullet-proofing
    If Not pvtSetParent( _
            Parent:=Parent, _
            MethodName:="Add") Then
        Set Add = Item
        GoTo Add_Exit
    End If
    If IsMissing(Item) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Add' method for this object because the 'Item:=' parameter is missing."
        Set Add = Item
        GoTo Add_Exit
    End If

' support database-free emulation of the VB Collection Class
    tempSuppressInsert = False
    If Item.ObjectDataSource = "" _
    Or Err = 438 Then
        pvtCollectionEmulationMode = True
        tempSuppressInsert = True
    End If
    If Not IsMissing(NoInsert) Then
        If NoInsert = True Then
            tempSuppressInsert = True
        End If
    End If

' verify that the object is unique across
'   the known system objects
'   (First pass.  Works only when adding
'   Object to a subsequent Collection)
    tempFoundInFirstPass = False
    Set tempObject = _
        pvtVBOFObjectManager. _
            AddUniqueObject _
                (Object:=Item)
    If Not pvtVBOFObjectManager.ObjectWasUnique Then
        tempFoundInFirstPass = True
    End If

'>>if tempObject= is moved, change tempObject.*
'   to Item.* down to "where tempObject= used to be"

' if in an Insert-capable mode
    If Not tempSuppressInsert _
    And Not tempFoundInFirstPass Then

' if Item.ObjectID doesn't already have a value
'   (meaning that it has never been inserted in
'   the database),
        If tempObject.ObjectID <= 0 Then

' insert Item and set Item.ObjectID
            Item.ObjectID = _
                pvtDBInsert( _
                    Item:=tempObject)
        End If

' else, if the ObjectID doesn't already have a value
'   assign an artificial ObjectID
    ElseIf Not tempFoundInFirstPass Then
        pvtVBOFObjectManager.HighestObjectID = _
            pvtVBOFObjectManager.HighestObjectID + 1
        tempObject.ObjectID = _
            pvtVBOFObjectManager.HighestObjectID
    End If

' save the HighestObjectID encountered
    If tempObject.ObjectID > _
    pvtVBOFObjectManager.HighestObjectID Then
        pvtVBOFObjectManager. _
            HighestObjectID = _
                tempObject.ObjectID
    End If

' verify that the object is unique across
'   the known system objects
'   (Second pass.  Finds redundantly inserted
'   Objects)
    If Not tempFoundInFirstPass Then
        Set tempObject = _
            pvtVBOFObjectManager. _
                AddUniqueObject _
                    (Object:=tempObject)
    End If

' use the Key:= if it was provided and it was
'   of Type(Long)
    If IsMissing(Key) Or Key = 0 Or Err = 13 Then
        pvtAddItemToCollection _
            Item:=tempObject, _
            Key:=CStr(tempObject.ObjectID), _
            After:=After

' else, use the Item.ObjectID
    Else
        pvtAddItemToCollection _
            Item:=tempObject, _
            Key:=Key, _
            After:=After
    End If

' link the Item to its Parent object
'   (in the database)
    If pvtCollectionEmulationMode = False Then
        RC = pvtLinkParentToChildObject( _
                Parent:=pvtParent, _
                Child:=tempObject)

        pvtRefreshRecordSet
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has added  ObjectType=" & _
            TypeName(tempObject) & _
            ", ObjectID=" & _
            tempObject.ObjectID
    End If
#End If

' trigger the "Added" event for the new object
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Object:=tempObject, _
        Event:="AddedItem"
#End If

    Set Add = tempObject
    GoTo Add_Exit

Add_Exit:
    Set pvtMostRecentlyAddedObject = tempObject
    Set tempObject = Nothing
End Function
Private Function pvtLinkParentToChildObject(Optional Parent As Variant, Optional Child As Variant) As Long

    Dim SQLStatement As String

    On Local Error Resume Next

    If pvtCollectionEmulationMode Then
        pvtLinkParentToChildObject = True
    End If

' insert a row into the VBObjectFrameworkObjectLinks table
    SQLStatement = _
        "INSERT INTO " & ObjectDataSource() & " " & _
        "(FromObjectType" & _
        ",FromObjectID" & _
        ",ToObjectType" & _
        ",ToObjectID"
    SQLStatement = SQLStatement & _
        ") VALUES " & _
        "('" & TypeName(Parent) & "'" & _
        ", " & Parent.ObjectID & "" & _
        ",'" & TypeName(Child) & "'" & _
        ", " & Child.ObjectID & ""
    SQLStatement = SQLStatement & _
        ")"

    pvtDatabase.Execute SQLStatement, pvtODBCPassThrough
    If Err <> 0 Then '
        pvtErrorMessage TypeName(Me) & " received a database error while attempting to establish an object containment link (Insert).  SQL=" & SQLStatement
        pvtLinkParentToChildObject = False
        Exit Function
    End If

    pvtLinkParentToChildObject = True
End Function


Public Property Get MostRecentlyAddedObject() As Variant
Attribute MostRecentlyAddedObject.VB_Description = "Returns the most recently added object"
' Returns the Object most recently added to the
'   VBOFCollection

    Set MostRecentlyAddedObject = _
        pvtMostRecentlyAddedObject

End Property

Public Property Get MostRecentlyAddedObjectIndex() As Long
Attribute MostRecentlyAddedObjectIndex.VB_Description = "Returns the collection index of the most recently added object"
' Returns the Index in the Collection of the
'   Object most recently added to the
'   VBOFCollection

    MostRecentlyAddedObjectIndex = _
        CollectionIndex _
            (Item:=pvtMostRecentlyAddedObject)

End Property



Public Function pvtCloneRecordSet() As RecordSet
Attribute pvtCloneRecordSet.VB_Description = "Returns a Clone of the internally maintained RecordSet object"
    Set pvtCloneRecordSet = pvtRecordSet.Clone()
End Function

Public Function CollectionIndex(Optional Item As Variant, Optional Key As Variant, Optional WhereClause As Variant, Optional FindFirst As Variant, Optional FindNext As Variant, Optional FindLast As Variant, Optional FindPrevious As Variant, Optional Collection As Variant) As Long
Attribute CollectionIndex.VB_Description = "Returns the index (1 - n) of the item in the collection"
' Returns the Collection Index of the
'   specified Item, or the item at the specified Key
' Program Usage:
'   Dim MyCollection as VBOFCollection
'   MyIndex = MyCollection.CollectionIndex _
'                (Item:=MyObject)
' or
'   MyIndex = MyCollection.CollectionIndex _
'                (Key:=MyKey)
' or
'   MyIndex = MyCollection.CollectionIndex _
'                (WhereClause:="LastName = 'Jones'")
'       (see comments in method "pvtCollectionIndexForWhereClause"
'       for important information about using the
'       WhereClause:= parameter)
' or
'   MyIndex = MyCollection.CollectionIndex _
'                (WhereClause:="LastName = 'Jones'", _
'                 FindFirst:=True)
'       (see comments in method "pvtCollectionIndexForWhereClause"
'       for important information about using the
'       WhereClause:= parameter)
'
' Parameters:
'   Item - the object whose Collection Index is
'       desired
'   Key - the key value of the object whose
'       Collection Index is desired
'   WhereClause - a search string which can be
'       appended to the RecordSet.FindNext method
'   FindNext - a boolean which determines whether
'       the FindNext method should be used
'       (FindNext is the default)
'   FindFirst - a boolean which determines whether
'       the FindFirst method should be used
'       (FindNext is the default)
'   FindLast - a boolean which determines whether
'       the FindLast method should be used
'       (FindNext is the default)
'   FindPrevious - a boolean which determines whether
'       the FindPrevious method should be used
'       (FindNext is the default)

    Dim tempItem As Object
    Dim I As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Item) _
    And IsMissing(Key) _
    And IsMissing(WhereClause) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.CollectionIndex' method for this object because the 'Item:=', 'Key:=' and 'WhereClause:=' parameters are missing."
        CollectionIndex = -1
        GoTo CollectionIndex_Exit
    End If

' branch to an appropriate private method
    If Not IsMissing(Item) Then
        CollectionIndex = _
            pvtCollectionIndexForItem( _
                Item:=Item, _
                Collection:=Collection)
    ElseIf Not IsMissing(Key) Then
        CollectionIndex = _
            pvtCollectionIndexForKey( _
                Key:=Key, _
                Collection:=Collection)
    ElseIf Not IsMissing(WhereClause) Then
        CollectionIndex = _
            pvtCollectionIndexForWhereClause( _
                WhereClause:=WhereClause, _
                FindFirst:=FindFirst, _
                FindLast:=FindLast, _
                FindNext:=FindNext, _
                FindPrevious:=FindPrevious)
    Else
        CollectionIndex = -1
    End If

    GoTo CollectionIndex_Exit

CollectionIndex_Exit:
    Set tempItem = Nothing
End Function


Private Function pvtCollectionIndexForItem(Optional Item As Variant, Optional Collection As Variant) As Long
' Returns the Collection Index of the
'   specified Item

    Dim tempItem As Object
    Dim I As Long
    Dim tempCollection As Collection

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Item) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtCollectionIndexForItem' method for this object because the 'Item:=' parameter is missing."
        pvtCollectionIndexForItem = -1
        Exit Function
    End If
    If Not IsMissing(Collection) Then
        Set tempCollection = Collection
    Else
        Set tempCollection = pvtCollection
    End If

' search each Object in the Collection
    I = 1
    For Each tempItem In tempCollection
        If CStr(tempItem.ObjectID) = CStr(Item.ObjectID) Then
            If Err = 0 Then ' <=== VB4 Error: for some reason this doesn't work if placed in the above statement as an "And"
                pvtCollectionIndexForItem = I
                GoTo pvtCollectionIndexForItem_Exit
            End If
        End If

        I = I + 1
    Next tempItem

    pvtCollectionIndexForItem = -1
    GoTo pvtCollectionIndexForItem_Exit

pvtCollectionIndexForItem_Exit:
    Set tempItem = Nothing
End Function

Private Function pvtCollectionIndexForKey(Optional Key As Variant, Optional Collection As Variant) As Long
' Returns the Collection Index of the Item at the
'   specified Key

    Dim tempItem As Object
    Dim I As Long
    Dim tempCollection As Collection

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Key) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtCollectionIndexForKey' method for this object because the 'Key:=' parameter is missing."
        pvtCollectionIndexForKey = -1
        Exit Function
    End If
    If Not IsMissing(Collection) Then
        Set tempCollection = Collection
    Else
        Set tempCollection = pvtCollection
    End If

    I = 1
    For Each tempItem In tempCollection
        If CStr(tempItem.ObjectID) = CStr(Key) Then
            If Err = 0 Then ' <=== VB4 Error: for some reason this doesn't work if placed in the above statement as an "And"
                pvtCollectionIndexForKey = I
                GoTo pvtCollectionIndexForKey_Exit
            End If
        End If

        I = I + 1
    Next tempItem

    pvtCollectionIndexForKey = -1
    GoTo pvtCollectionIndexForKey_Exit

pvtCollectionIndexForKey_Exit:
    Set tempItem = Nothing
End Function



Public Function Count() As Long
Attribute Count.VB_Description = "Returns a count of the number of items currently in the collection.  See the VB Programmer's Manual for details"
' Returns the count of objects currently defined
'   as part of the collection

    Count = pvtCollection.Count
End Function

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

Public Property Set Database(Database As Database)

    If Not IsMissing(Database) Then
        pvtReceiveGeneralParameters _
            Database:=Database

        pvtCollectionEmulationMode = False
    End If

End Property


Public Function pvtDatabaseHasBeenReferenced() As Boolean
Attribute pvtDatabaseHasBeenReferenced.VB_Description = "Returns turue or false, depending on whether or not the DBAwareCollection has referenced the database to attempt to instantiate the collection of contained objects"
' Returns aBoolean, depending on whether or not the
'   Database has been referenced as of yet for this
'   VBOFCollection

    pvtDatabaseHasBeenReferenced = _
        pvtDBHasBeenReferenced
End Function

Private Function pvtPopulateFromDatabase(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 ANSISQL As Variant, Optional ODBCPassThrough As Variant) As VBOFCollection
Attribute pvtPopulateFromDatabase.VB_Description = "Returns a DBAwareCollection which has been instantiated with a collection of instantiated objects, according to the contents of the associated table"
' Returns a VBOFCollection of objects which have been
'   populated from data found in a database
'   table meeting the criteria specified in any of
'   the following methods:
'       a complete SQL statement can be provided;
'       a Where Clause can be provided;
'       a Parent Object can be provided
'
' Parameter Description:
'       see VBOFObjetManager.ManageCollection

    Dim tempRow As Object
    Dim newChildObject As Object
    Dim tempIndex As Long

    On Local Error Resume Next

    Set pvtPopulateFromDatabase = Nothing
    pvtRecordSetProvidedByUser = False

' test Sample for Database-readiness
    If Not IsMissing(Sample) Then
        If (Sample.ObjectDataSource = "" _
        Or Err = 438) Then
            pvtCollectionEmulationMode = True
        End If
    End If

    pvtReceiveGeneralParameters _
        Database:=Database, _
        Sample:=Sample, _
        Parent:=Parent, _
        WhereClause:=WhereClause, _
        OrderByClause:=OrderByClause, _
        ANSISQL:=ANSISQL, _
        ODBCPassThrough:=ODBCPassThrough, _
        SQL:=SQL

' determine the usability of the parameters
    If Not pvtIsDatabaseSpecified() _
    Or Not pvtIsSQLAccessable() _
    Then
        Exit Function
    End If

' open a RecordSet containing the desired rows
    Set pvtRecordSet = _
        pvtDBSelect(pvtCreateSQLStatement())

' create the objects from the contents of the
'   RecordSet

    Set pvtCollection = _
        pvtInstantiateObjectsFromRecordSet( _
            RecordSet:=pvtRecordSet, _
            Collection:=pvtCollection)

pvtPopulateFromDatabase_Exit:
#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has instantiated a collection of objects from the Database.  " & _
            "Object count=" & pvtCollection.Count & ", ParentType=" & _
            TypeName(Parent) & ", ObjectID=" & _
            Parent.ObjectID & ", ChildObjectType=" & _
            TypeName(Sample)
    End If
#End If

' trigger the "PopulatedFromDatabase" event for Me
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Event:="PopulatedFromDatabase"
#End If

    Set pvtPopulateFromDatabase = Me
    Set tempRow = Nothing
    Set newChildObject = Nothing
End Function


Private Sub pvtDBGridBookmarkArrayClear()

    ReDim Preserve _
        pvtDBGridBookmarkArray(1 To 2, 0)

    pvtDBGridBookmarkArrayAvailable = False
End Sub

Public Function Item(Optional ObjectID As Variant) As Variant
Attribute Item.VB_Description = "Returns either the entire VBOFCollection (as a collection) or a specific item.  See the VB Programmer's Manual for details"
' Returns either the entire collection or a
'   specific item in the collection
' As with the standard VB Collection object,
'   if Item:= is specified, then the requested
'   object is returned (if it can be found),
'   otherwise the entire collection is returned

    On Local Error Resume Next

' determine the usability of the current state
    If Not pvtCollectionEmulationMode Then
        If Not pvtIsDatabaseSpecified() _
        Or Not pvtIsSQLAccessable() _
        Or Not pvtIsCollectionInstantiated() _
        Then
            Exit Function
        End If
    End If

' check for a request for a specific Object
    If Not IsMissing(ObjectID) Then
        Set Item = pvtCollection.Item(ObjectID)
        If Err = 5 Then
            Set Item = Nothing
            Exit Function
        End If
    Else
        Set Item = Me
    End If
End Function



Public Property Get pvtListBoxSelectObject(ListBox As Variant) As Variant
' Returns the selected object from the ListBox
' Note:  this method should be coded as follows:
'       Dim MyDesiredObject As MyClass
'       Set MyDesiredObject = _
'           MyVBOFCollection.pvtListBoxSelectObject _
'               (MyListBox)

    Dim tempIndex As Long
    Dim tempObject As Object
    Dim tempCollection As Collection

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(ListBox) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'ListBox' or 'Collection' parameter is missing."
            Set pvtListBoxSelectObject = Nothing
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    Set tempCollection = _
        pvtListBoxSelectedObjects(pvtListBox)

    If tempCollection.Count >= 1 Then
        Set pvtListBoxSelectObject = _
            tempCollection.Item(1)
    Else
        Set pvtListBoxSelectObject = _
            Nothing
    End If

    Set tempObject = Nothing
End Property

Public Property Set pvtListBoxSelectObject(ListBox As Variant, Object As Variant)
' Selects the specified Object from the ListBox
' Note:  this method should be coded as follows:
'       Dim MyDesiredObject As MyClass
'       MyVBOFCollection.pvtListBoxSelectObject _
'               (MyListBox) = MyDesiredObject

    Dim tempIndex As Long

' bullet-proofing
    If IsMissing(ListBox) Or IsMissing(Object) Then
        If pvtListBox Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.pvtListBoxSelectObject' method for this object because the 'ListBox' or 'Object' parameter is missing."
            Exit Property
        End If
    Else
        Set pvtListBox = ListBox
    End If

    If Object Is Nothing Then
        Exit Property
    End If

' find Object in the collection
    tempIndex = _
        CollectionIndex(Item:=Object)

' handle 'Not Found'
    If tempIndex <= 0 Then
        Exit Property
    End If

' select the corresponding ListBox item
    pvtListBox.Selected(tempIndex - 1) = True

End Property



Public Property Set ObjectManager(anObjectManager As VBOFObjectManager)
' Set my reference to the VBOFObjectManager
'   and register for Collection Events

    Set pvtVBOFObjectManager = anObjectManager

#If NoEventMgr = False Then
    pvtVBOFObjectManager. _
        RegisterForCollectionEvent _
        RegisterObject:=Me
#End If
End Property


Public Property Get Parent()
Attribute Parent.VB_Description = "Sets the Parent property"
' Returns the most recently specified
'   Parent:= object

    Set Parent = pvtParent
End Property

Private Function pvtAddItemToCollection(Optional Item As Variant, Optional Key As Variant, Optional After As Variant) As Collection
Attribute pvtAddItemToCollection.VB_Description = "(Private) adds an item to the internally managed collection"
' Return the VBOFCollection after having added
'   Item.  Take into account the impact of the
'   After parameter

    Dim tempAfter As Long
    Dim tempCollectionIndex As Long

    On Local Error Resume Next

' set default After value
    tempAfter = pvtCollection.Count

' use any specified After value
    If Not IsMissing(After) Then
        If After <= pvtCollection.Count Then
            tempAfter = After
        End If
    End If

' insert somewhere after the first item
    If tempAfter > 0 Then
        pvtCollection.Add _
            Item:=Item, _
            Key:=CStr(Item.ObjectID), _
            After:=tempAfter

' insert before the first item
    ElseIf pvtCollection.Count > 0 Then
        pvtCollection.Add _
            Item:=Item, _
            Key:=CStr(Item.ObjectID), _
            Before:=1

' insert as the first item
    Else
        pvtCollection.Add _
            Item:=Item, _
            Key:=CStr(Item.ObjectID)
    End If

' add the reference to the pvtDBGridBookmarkArray
    If Err = 0 Then
        pvtAddItemToDBGridArray _
            Item:=Item
    End If

    Set pvtAddItemToCollection = _
        pvtCollection
End Function

Private Sub pvtAddItemToDBGridArray(Optional Item As Variant, Optional Collection As Variant)
' Add the Item to the pvtDBGridBookmarkArray

    Dim tempCollectionIndex As Long

    tempCollectionIndex = _
        CollectionIndex( _
            Item:=Item, _
            Collection:=Collection)

    If tempCollectionIndex > 0 Then
        pvtDBGridBookmarkArrayAdd _
            tempCollectionIndex - 1, _
            tempCollectionIndex - 1, _
            CStr(Item.ObjectID)
    End If
'DebugpvtDBGridBookmarkArray
End Sub

Private Function pvtBuildSQLStatementFromWhereClause(Optional WhereClause As Variant) As String
Attribute pvtBuildSQLStatementFromWhereClause.VB_Description = "(Private) returns an SQL Select statement which includes a user-specified Where clause.  The SQL statement should be appropriate for retrieving all of the items contained within the specified parent object"
' Return an SQL Statement which uses WhereClause to
'   select the desired rows

    Dim SQLStatement As String

    On Local Error Resume Next

' ask the Sample for certain critical services
    pvtSampleTableName = pvtSample.ObjectDataSource
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(pvtSample) & "' does not support the method 'TableName'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
    End If

    pvtSampleType = TypeName(pvtSample)
'    If Err = pvtReceiverDoesNotSupportThisMethod Then
'        pvtErrorMessage "Class Module '" & TypeName(pvtSample) & "' does not support the method 'ObjectType'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
'    End If

    On Local Error Resume Next

    SQLStatement = _
        "SELECT DISTINCTROW " & _
        pvtSampleTableName & ".* FROM " & _
        pvtSampleTableName & " WHERE " & _
        WhereClause
    SQLStatement = SQLStatement & _
        pvtConcatenateOrderByClause( _
            SQL:=SQLStatement, _
            OrderByClause:=pvtOrderByClause)

    pvtBuildSQLStatementFromWhereClause = SQLStatement
End Function


Private Function pvtBuildSQLStatementFromParent(Optional Parent As Variant) As String
Attribute pvtBuildSQLStatementFromParent.VB_Description = "(Private) returns an SQL Select statement which can be used to retrieve all of the items contained within the specified parent object"
' Returns an SQL Statement which retrieves rows
'   of the child table based on the value of
'   the Parent object.  If a WhereClause has been
'   specified, it is appended to the end of the
'   standard SQL statement for object containment.

    Dim SQLStatement As String

    If Not pvtSetParent( _
            Parent:=Parent, _
            MethodName:="pvtBuildSQLStatementFromParent") Then
        pvtBuildSQLStatementFromParent = ""
        Exit Function
    End If

    SQLStatement = _
        pvtBuildSQLStatementFromParentCode( _
            Sample:=pvtSample, _
            Parent:=pvtParent)

' concatenate the supplemental Where Clause
    If pvtWhereClause <> "" Then
        SQLStatement = SQLStatement & _
            " AND " & pvtWhereClause
    End If

' concatenate the OrderBy Clause
    SQLStatement = SQLStatement & _
        pvtConcatenateOrderByClause( _
            SQL:=SQLStatement, _
            OrderByClause:=pvtOrderByClause)

    pvtBuildSQLStatementFromParent = SQLStatement
End Function

Private Function pvtBuildSQLStatementFromParentCode(Optional Parent As Variant, Optional Sample As Variant) As String
' Returns an SQL Statement which retrieves rows
'   of the child table based on the value of
'   the Parent object.  If a WhereClause has been
'   specified, it is appended to the end of the
'   standard SQL statement for object containment.

    Dim SQLStatement As String

    On Local Error Resume Next

' ask the Sample for certain critical services
    pvtSampleTableName = _
        Sample.ObjectDataSource
    pvtSampleType = _
        TypeName(Sample)
    pvtParentTableName = _
        Parent.ObjectDataSource
    pvtParentType = _
        TypeName(Parent)

' (SQL Statement modeled in MS Access)
'SELECT DISTINCTROW
'       Persons.* FROM (VBObjectFrameworkObjectLinks INNER JOIN
'       Company ON VBObjectFrameworkObjectLinks.FromObjectID =
'       Company.ObjectID) INNER JOIN
'       Persons ON VBObjectFrameworkObjectLinks.ToObjectID =
'       Persons.ObjectID WHERE ((VBObjectFrameworkObjectLinks.FromObjectType="
'       Company") AND (VBObjectFrameworkObjectLinks.ToObjectType="
'       Person") AND (
'       Company.ObjectID=
'       1));
    If Not pvtANSISQL Then
        SQLStatement = _
            "SELECT DISTINCTROW " & _
            pvtSampleTableName & ".* FROM (" & ObjectDataSource() & " INNER JOIN " & _
            pvtParentTableName & " ON " & ObjectDataSource() & ".FromObjectID = " & _
            pvtParentTableName & ".ObjectID) INNER JOIN " & _
            pvtSampleTableName & " ON " & ObjectDataSource() & ".ToObjectID = " & _
            pvtSampleTableName & ".ObjectID WHERE ((" & ObjectDataSource() & ".FromObjectType='"
        SQLStatement = SQLStatement & _
            pvtParentType & "') AND (" & ObjectDataSource() & ".ToObjectType='" & _
            pvtSampleType & "') AND (" & _
            pvtParentTableName & ".ObjectID=" & _
            CStr(Parent.ObjectID) & "))"
    Else
        SQLStatement = _
            "SELECT " & _
            pvtSampleTableName & ".* FROM " & _
            pvtSampleTableName & ", " & _
            pvtParentTableName & ", " & _
            ObjectDataSource() & " "
        SQLStatement = SQLStatement & _
            "WHERE " & _
            ObjectDataSource() & ".FromObjectID = " & _
            pvtParentTableName & ".ObjectID AND " & _
            ObjectDataSource() & ".ToObjectID = " & _
            pvtSampleTableName & ".ObjectID "
        SQLStatement = SQLStatement & _
            "AND " & _
            ObjectDataSource() & ".FromObjectType='" & _
            pvtParentType & "' AND " & ObjectDataSource() & ".ToObjectType='" & _
            pvtSampleType & "' AND " & _
            pvtParentTableName & ".ObjectID=" & _
            CStr(Parent.ObjectID)
    End If

    pvtBuildSQLStatementFromParentCode = SQLStatement
End Function


Private Sub pvtDBGridBookmarkArrayAdd(RowIndex As Long, Bookmark As Variant, ObjectID As Variant)
' Adds an Object / DBGrid Row cross-reference element

    Dim tempMaxIndex As Long
    Dim I As Long

    On Local Error GoTo pvtDBGridBookmarkArrayAdd_Exit

    tempMaxIndex = UBound(pvtDBGridBookmarkArray, 2)

' if adding the new RowIndex at the end
    If RowIndex > tempMaxIndex _
    Or Not pvtDBGridBookmarkArrayAvailable Then
        ReDim Preserve _
            pvtDBGridBookmarkArray( _
                1 To 2, _
                0 To RowIndex)

' if adding somewhere in the middle
    Else
        ReDim Preserve _
            pvtDBGridBookmarkArray( _
                1 To 2, _
                0 To tempMaxIndex + 1)
    End If

' up-shift the lower-position entries
    For I = UBound(pvtDBGridBookmarkArray, 2) - 1 _
    To RowIndex Step -1
        pvtDBGridBookmarkArray(1, I + 1) = _
            pvtDBGridBookmarkArray(1, I)

        pvtDBGridBookmarkArray(2, I + 1) = _
            pvtDBGridBookmarkArray(2, I)
    Next I

    pvtDBGridBookmarkArrayAvailable = True

    pvtDBGridBookmarkArray(1, RowIndex) = CStr(Bookmark)
    pvtDBGridBookmarkArray(2, RowIndex) = ObjectID
pvtDBGridBookmarkArrayAdd_Exit:
    Exit Sub
End Sub


Private Sub pvtDBGridBookmarkArrayDeleteBookmark(Bookmark As Variant)

    Dim tempRowIndex As Long

    tempRowIndex = _
        pvtDBGridRowIndexAtBookmark(Bookmark)

    If tempRowIndex >= 0 Then
        pvtDBGridBookmarkArrayDeleteRowIndex _
          (tempRowIndex)
    End If

End Sub

Private Sub pvtDBGridBookmarkArrayDeleteRowIndex(RowIndex As Long)
' Deletes an Object / DBGrid Row cross-reference
'   element by its RowIndex

    Dim I As Long

    For I = RowIndex To _
    UBound(pvtDBGridBookmarkArray, 2) - 1
        pvtDBGridBookmarkArray(1, I) = _
            pvtDBGridBookmarkArray(1, I + 1)

        pvtDBGridBookmarkArray(2, I) = _
            pvtDBGridBookmarkArray(2, I + 1)
    Next I

    ReDim Preserve pvtDBGridBookmarkArray( _
        1 To 2, _
        0 To UBound(pvtDBGridBookmarkArray, 2) - 1)
End Sub




Private Function pvtDBGridBookmarkAtRowIndex(RowIndex As Long) As Variant

    pvtDBGridBookmarkAtRowIndex = _
        pvtDBGridBookmarkArray _
                    (1, RowIndex)
End Function


Private Function pvtDBGridObjectIDAtBookmark(Bookmark As Variant) As Variant

    On Local Error GoTo pvtDBGridObjectIDAtBookmark_Error

    pvtDBGridObjectIDAtBookmark = _
        pvtDBGridBookmarkArray( _
            2, _
            pvtDBGridRowIndexAtBookmark(Bookmark))

pvtDBGridObjectIDAtBookmark_Error:
    Exit Function
End Function



Private Function pvtDBGridObjectIDAtRowIndex(RowIndex As Long) As Variant

    pvtDBGridObjectIDAtRowIndex = _
        pvtDBGridBookmarkArray _
                    (2, RowIndex)
End Function


Private Function pvtDBGridRowIndexAtBookmark(Bookmark As Variant) As Long

    On Local Error GoTo pvtDBGridRowIndexAtBookmark_Error

    Dim I As Long

    For I = 0 _
    To UBound(pvtDBGridBookmarkArray, 2)
        If pvtDBGridBookmarkArray(1, I) = Bookmark Then
            pvtDBGridRowIndexAtBookmark = I
            Exit Function
        End If
    Next I

pvtDBGridRowIndexAtBookmark_Error:
    pvtDBGridRowIndexAtBookmark = -1
    Exit Function
End Function


Private Function pvtDBGridRowIndexAtObjectID(ObjectID As Variant) As Long

    Dim I As Long

    For I = 0 _
    To UBound(pvtDBGridBookmarkArray, 2)
        If pvtDBGridBookmarkArray(2, I) = ObjectID Then
            pvtDBGridRowIndexAtObjectID = I
            Exit Function
        End If
    Next I

    pvtDBGridRowIndexAtObjectID = -1
End Function


Private Function pvtDBGridGetRelativeBookmark(Bookmark As Variant, Increment As Long, MaxRow As Long) As Variant

    Dim I As Long

    I = pvtDBGridIndexFromBookmark _
            (Bookmark, False, MaxRow) + _
            Increment
    If I < 0 Or I >= MaxRow Then
        pvtDBGridGetRelativeBookmark = Null
    Else
        pvtDBGridGetRelativeBookmark = _
            pvtDBGridMakeBookmark(I)
    End If

End Function

Private Function pvtDBGridIndexFromBookmark(Bookmark As Variant, ReadPriorRows As Boolean, MaxRow As Long) As Long

    Dim I As Long

    If IsNull(Bookmark) Then
        If ReadPriorRows Then
            pvtDBGridIndexFromBookmark = MaxRow
        Else
            pvtDBGridIndexFromBookmark = -1
        End If
    Else
        I = Val(Bookmark)

        If I < 0 Or I >= MaxRow Then
            I = -MaxRow
        End If

        pvtDBGridIndexFromBookmark = I
    End If

End Function

Private Function pvtDBGridMakeBookmark(Index As Long) As Variant
    pvtDBGridMakeBookmark = CStr(Index)
End Function


Private Function pvtDBGridObjectAtRowIndex(RowIndex As Long) As Variant
' Returns the Object which occupies the row in the
'   DBGrid specified by RowIndex

    pvtDBGridObjectAtRowIndex = _
        pvtCollection.Item _
            (CollectionIndex _
                (Key:=CStr(pvtDBGridBookmarkArray _
                    (2, RowIndex))))

End Function


Private Function pvtIsCollectionInstantiated() As Long
Attribute pvtIsCollectionInstantiated.VB_Description = "(Private) internal function"
' Verify that the pvtCollection has been
'   instantiated

    If pvtCollection Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot provide meaningfuly functionality because the collection has not been built."
        pvtIsCollectionInstantiated = False
        Exit Function
    End If

    pvtIsCollectionInstantiated = True
End Function

Private Function pvtIsRecordSetInitialized() As Long
Attribute pvtIsRecordSetInitialized.VB_Description = "(Private) internal function"
' Verify that the RecordSet has been initialized

    If pvtRecordSet Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot insert data into the database because the collection was never built."
        pvtIsRecordSetInitialized = False
        Exit Function
    End If

    pvtIsRecordSetInitialized = True
End Function

Private Function pvtIsSQLAccessable() As Long
Attribute pvtIsSQLAccessable.VB_Description = "(Private) internal function"
' Determine whether or not the desired table data
'   can be derived, given the information provided

    If (pvtParent Is Nothing _
    And pvtWhereClause = "" _
    And pvtSQLStatement = "" _
    ) Then
        pvtErrorMessage TypeName(Me) & " cannot perform object instantiations without having been provided with either an SQL:=, a WhereClause:= or a Parent:= ."
        pvtIsSQLAccessable = False
        Exit Function
    End If

    pvtIsSQLAccessable = True
End Function


Public Function Collection() As Collection
Attribute Collection.VB_Description = "Returns the underlying VB Collection"
' Returns the underlying Collection object

    Set Collection = pvtCollection
End Function

Private Function pvtConcatenateOrderByClause(Optional SQL As Variant, Optional OrderByClause As Variant) As String
' Return either a null string or an OrderBy clause
'   including the leading "Order By"

    If OrderByClause <> "" Then
        pvtConcatenateOrderByClause = _
            " ORDER BY " & _
            OrderByClause
    Else
        pvtConcatenateOrderByClause = ""
    End If

End Function


Private Function pvtCreateSQLStatement() As String
Attribute pvtCreateSQLStatement.VB_Description = "(Private) internal function"
' Evaluate the available information and create
'   an SQL Statement to access the desired rows

' decide how to acquire an SQL Statement:
'   first try the SQL Statement variable
    If pvtSQLStatement = "" Then
            pvtSQLStatement = _
                pvtBuildSQLStatementFromParent( _
                    Parent:=pvtParent)
    End If

    pvtCreateSQLStatement = pvtSQLStatement
End Function

Private Function pvtDBInsert(Optional Item As Variant) As Long
Attribute pvtDBInsert.VB_Description = "(Private) inserts the item from the associated table"
' Insert Item into the table, then return
'   its ObjectID value

    Dim tempObjectErr As Long
    Dim tempBookmark As String

    On Local Error Resume Next

    If Not pvtIsRecordSetInitialized() Then
        pvtDBInsert = False
        Exit Function
    End If

' prepare a new record area
    pvtRecordSet.AddNew

' have the Item populate the RecordSet.
'   check for errors on that end
    Err = 0
    tempObjectErr = _
        Item.ObjectInitializeRecordSet(pvtRecordSet)
    If tempObjectErr <> 0 _
    Or Err <> 0 Then
        If Err = pvtReceiverDoesNotSupportThisMethod Or tempObjectErr = pvtReceiverDoesNotSupportThisMethod Then
            pvtErrorMessage "Class Module '" & TypeName(Item) & "' does not support the method 'InitializeRecordSet'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
        End If

        pvtDBInsert = 0
        Exit Function
    End If

' execute the update
    pvtRecordSet.Update

' Note: the following "If" line is commented because
'   it is possible for Err to be contanimated by the
'   application if it is using this RecordSet, say
'   attached to a DataControl with a Reposition
'   event coded.
' return the ObjectID
'    If Err = 0 Then
        tempBookmark = pvtRecordSet.LastModified
        pvtRecordSet.Bookmark = tempBookmark
'    End If

    pvtDBInsert = pvtRecordSet("ObjectID")
End Function


Private Function pvtErrorMessage(Optional ErrorMessage As Variant) As Long
Attribute pvtErrorMessage.VB_Description = "(Private) internal function"
    pvtErrorMessage = _
        pvtVBOFObjectManager.DisplayErrorMessage _
            (ErrorMessage)
End Function


Public Property Get ObjectManager() As VBOFObjectManager
' Return my reference to the VBOFObjectManager

    Set ObjectManager = pvtVBOFObjectManager
End Property


Private Function pvtDBSelect(Optional SQL As Variant) As RecordSet
Attribute pvtDBSelect.VB_Description = "(Private) selects the contained items from the associated table"
' Process the SQL Select statement and return
'   a RecordSet

' open a RecordSet containing the desired rows
    Set pvtDBSelect = _
        pvtDatabase. _
            OpenRecordset( _
                SQL, _
                dbOpenDynaset, pvtODBCPassThrough)

    pvtDBHasBeenReferenced = True
End Function

Private Function pvtDBUpdate(Optional Item As Variant) As VBOFCollection
Attribute pvtDBUpdate.VB_Description = "(Private) updates the item from the associated table"
' Update the Item in the table

    On Local Error Resume Next

    If pvtRecordSet Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot update data in the database because the collection was never built."
        Set pvtDBUpdate = Nothing
        Exit Function
    End If

' prepare a new record area
    pvtRecordSet.Edit

' have the Item populate the RecordSet
    Item.ObjectInitializeRecordSet (pvtRecordSet)
    If Err = pvtReceiverDoesNotSupportThisMethod Then
        pvtErrorMessage "Class Module '" & TypeName(Item) & "' does not support the method 'InitializeRecordSet'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
    End If

' execute the update
    pvtRecordSet.Update

' return the colection
    Set pvtDBUpdate = Me
End Function

Private Function pvtDBDelete() As Long
Attribute pvtDBDelete.VB_Description = "(Private) deletes the item from the associated table"
' Delete the current row of the RecordSet

    On Local Error Resume Next

' bullet-proofing
    If pvtRecordSet Is Nothing Then
        pvtErrorMessage TypeName(Me) & " cannot delete data in the database because the collection was never built."
        pvtDBDelete = False
        Exit Function
    End If

' delete the record
    Err = 0
    pvtRecordSet.Delete

    If Err = 0 Then
        pvtDBDelete = True
    Else
        pvtDBDelete = False
    End If
End Function


Private Function pvtInstantiateObjectsFromRecordSet(Optional RecordSet As Variant, Optional Collection) As Collection
' Return a Collection of objects which have been
'   instantiated from data found in RecordSet

    Dim tempRow As Object
    Dim newChildObject As Object
    Dim tempIndex As Long
    Dim tempCollection As New Collection

    On Local Error Resume Next

' clear the pvtDBGridBookmarkArray
    pvtDBGridBookmarkArrayClear

' process the RecordSet
    While Not RecordSet.EOF

' determine whether or not the retrieved row
'   has an instantiated object already in the
'   VBOFCollection
        tempIndex = _
            CollectionIndex( _
                Item:=CStr(RecordSet("ObjectID")))
        If tempIndex > 0 Then
            Set newChildObject = _
                pvtCollection(tempIndex)

' else, must instantiate a new object of the class
        Else

' have the Sample Object return an instantiated
'   copy of itself
            Set newChildObject = _
                ObjectManager. _
                    pvtInstantiateNewObjectFromSample _
                        (Sample:=pvtSample)
            If newChildObject Is Nothing Then
                GoTo pvtInstantiateObjectsFromRecordSet_Error
            End If
        End If

' have the new instantiated object copy populate
'   itself from this RecordSet row
        Set newChildObject = _
            ObjectManager. _
                pvtObjectInitializeFromRecordSet( _
                    Object:=newChildObject, _
                    RecordSet:=RecordSet)
        If newChildObject Is Nothing Then
            GoTo pvtInstantiateObjectsFromRecordSet_Exit
        End If

' add the object to the collection
'   (if it is unique)
        pvtAddUniqueItemToCollection _
            Item:=newChildObject, _
            Parent:=Me, _
            Collection:=tempCollection

        RecordSet.MoveNext
    Wend

    GoTo pvtInstantiateObjectsFromRecordSet_Exit

pvtInstantiateObjectsFromRecordSet_Error:

pvtInstantiateObjectsFromRecordSet_Exit:
    Set pvtInstantiateObjectsFromRecordSet = _
        tempCollection
    Set tempRow = Nothing
    Set newChildObject = Nothing
End Function
Private Function pvtIsDatabaseSpecified() As Integer
Attribute pvtIsDatabaseSpecified.VB_Description = "(Private) internal function"
' 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 of the pvtPopulateFromDatabase method to specify the database."
        pvtIsDatabaseSpecified = False
        Exit Function
    End If

    pvtIsDatabaseSpecified = True
End Function

Private Function pvtSetParent(Optional Parent As Variant, Optional MethodName As Variant) As Boolean

    On Local Error Resume Next

    pvtSetParent = True

    If IsMissing(Parent) Then
        If pvtParent Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '." & MethodName & "' method for this object because the 'Parent:=' parameter is missing and no preceeding method has established a default object."
            pvtSetParent = False
        End If
    ElseIf Not Parent Is Nothing Then
        Set pvtParent = Parent
    End If

End Function

Private Function pvtSetSample(Optional Sample As Variant, Optional MethodName As Variant) As Boolean

    On Local Error Resume Next

    pvtSetSample = True

    If IsMissing(Sample) Then
        If pvtSample Is Nothing Then
            pvtErrorMessage TypeName(Me) & " cannot process the '." & MethodName & "' method for this object because the 'Sample' parameter is missing and no preceeding method has established a default."
            pvtSetSample = False
        End If
    End If

End Function


Private Sub pvtReceiveGeneralParameters(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)
Attribute pvtReceiveGeneralParameters.VB_Description = "(Private) internal function"
' Receive user-defined parameters

    If Not IsMissing(Database) Then
        Set pvtDatabase = Database
        pvtCollectionEmulationMode = False
    End If

    If Not IsMissing(Sample) Then
        Set pvtSample = Sample
    End If

    If Not IsMissing(Parent) Then

        Set pvtParent = Parent
    End If

    If Not IsMissing(WhereClause) Then
        pvtWhereClause = WhereClause
        pvtCollectionEmulationMode = False
    End If

    If Not IsMissing(SQL) Then
        pvtSQLStatement = SQL
        pvtCollectionEmulationMode = False
        pvtSQLStatementProvidedByUser = True
    End If

    If Not IsMissing(OrderByClause) Then
        pvtOrderByClause = OrderByClause
        pvtCollectionEmulationMode = False
    End If

    If Not IsMissing(CollectionEmulationMode) Then
        pvtCollectionEmulationMode = CollectionEmulationMode
    End If

    If Not IsMissing(ANSISQL) Then
        pvtANSISQL = ANSISQL
    End If

    If Not IsMissing(ODBCPassThrough) Then
        If ODBCPassThrough Then
            pvtODBCPassThrough = dbSQLPassThrough
        Else
            pvtODBCPassThrough = 0
        End If
    End If
End Sub

Public Property Get pvtRecordSetAbsolutePosition() As Long
' Gets the RecordSet's AbsolutePosition
'   property

    pvtRecordSetAbsolutePosition = _
        pvtRecordSet.AbsolutePosition
End Property

Public Property Let pvtRecordSetAbsolutePosition(RecordNumber As Long)
' Sets the RecordSet's AbsolutePosition
'   property

    pvtRecordSet.AbsolutePosition = _
        RecordNumber
End Property

Public Function pvtRecordSetMoveFirst() As Variant
' Moves the underlying RecordSet to the first record
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.MoveFirst

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetMoveFirst = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetMoveFirst = Nothing
    End If
End Function

Public Function pvtRecordSetFindFirst(Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the first
'   record meeting the specified criteria
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.FindFirst SearchCriteria

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetFindFirst = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetFindFirst = Nothing
    End If
End Function

Public Function pvtRecordSetFindNext(Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the next
'   record meeting the specified criteria
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.FindNext SearchCriteria

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetFindNext = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetFindNext = Nothing
    End If
End Function

Public Function pvtRecordSetFindPrevious(Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the previous
'   record meeting the specified criteria
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.FindPrevious SearchCriteria

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetFindPrevious = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetFindPrevious = Nothing
    End If
End Function


Public Function pvtRecordSetFindLast(Optional SearchCriteria As Variant) As Variant
' Searches the underlying RecordSet for the last
'   record meeting the specified criteria
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.FindLast SearchCriteria

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetFindLast = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetFindLast = Nothing
    End If
End Function



Public Function pvtRecordSetMoveLast() As Variant
' Moves the underlying RecordSet to the last record
'   and returns the object for that row

    Dim tempObject As Object

    On Local Error Resume Next

    pvtRecordSet.MoveLast

    pvtRecordSetMoveLast = True

    If pvtRecordSet.AbsolutePosition >= 0 Then
        Set pvtRecordSetMoveLast = _
            Item(pvtRecordSet.AbsolutePosition + 1)
    Else
        Set pvtRecordSetMoveLast = Nothing
    End If
End Function

Public Function pvtRecordSetMoveToRecordNumber(Optional RecordNumber As Variant) As Variant
' Moves the underlying RecordSet to the specified
'   record (by number) and returns the object for
'   that row

    Dim tempObject As Object

    On Local Error Resume Next

' bullet-proofing
    If pvtRecordSet.RecordCount < RecordNumber Then
        Set pvtRecordSetMoveToRecordNumber = Nothing
        Exit Function
    End If

    pvtRecordSet.AbsolutePosition = _
        RecordNumber

    Set pvtRecordSetMoveToRecordNumber = _
        Item(pvtRecordSet.AbsolutePosition) ' ObjectID:=CStr(pvtRecordSet("ObjectID")))
End Function

Public Function pvtRecordSetPositionToItem(Optional Item As Variant) As Variant
' Positions the underlying RecordSet to the
'   specifed Item and returns the Item

    Set pvtRecordSetPositionToItem = _
        pvtPositionRecordSetToItem _
            (Item:=Item)
End Function


Public Function pvtRecordSetRefresh() As RecordSet
' Pass thru to pvtRefreshRecordSet()

    Set pvtRecordSetRefresh = _
        pvtRefreshRecordSet()
End Function

Public Function pvtRecordSetBOF() As Boolean
' Returns a boolean, based on whether or not the
' underlying RecordSet is positioned at BOF

    On Local Error Resume Next

    pvtRecordSetBOF = _
        pvtRecordSet.BOF
End Function


Public Function pvtRecordSetRecordCount() As Long
' Returns the RecordCount property of the
' underlying RecordSet

    On Local Error Resume Next

    pvtRecordSetRecordCount = _
        pvtRecordSet.RecordCount
End Function

Public Function pvtRecordSetEOF() As Boolean
' Returns a boolean, based on whether or not the
'   underlying RecordSet is positioned at EOF

    On Local Error Resume Next

    pvtRecordSetEOF = _
        pvtRecordSet.EOF
End Function


Public Function pvtRefreshRecordSet() As RecordSet
Attribute pvtRefreshRecordSet.VB_Description = "Refreshes the internally managed RecordSet which equates to the rows of the table which were used to instantiate the contained items.  Returns the RecordSet"
' Return the refreshed RecordSet after having refreshed its
'   contents by again using the same SQL-oriented
'   information used previously to generate the current
'   VBOFCollection state.
' Note: users of the method "pvtPopulateFromRecordSet"
'   should not use this method

    On Local Error Resume Next

    If pvtRecordSetProvidedByUser Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtRefreshRecordSet' method because the RecordSet used to instantiate the objects was provided by the user via the '.pvtPopulateFromRecordSet' method."
        Set Refresh = Me
    End If

    Refresh

    Set pvtRefreshRecordSet = pvtRecordSet
End Function


Public Sub SetDatabaseParameters(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)
Attribute SetDatabaseParameters.VB_Description = "(Private) Allows the user to set all of the database-related parameters in a single statement"
' Receive any database parameters the application
'   program wishes to set en masse.  As an
'   alternative, the application can provide
'   certain parameters for certain methods,
'   such as the .pvtPopulateFromRecordSet
'   and .pvtPopulateFromDatabase methods

    pvtReceiveGeneralParameters _
        Database:=Database, _
        Sample:=Sample, _
        Parent:=Parent, _
        WhereClause:=WhereClause, _
        OrderByClause:=OrderByClause, _
        SQL:=SQL, _
        CollectionEmulationMode:=CollectionEmulationMode, _
        ANSISQL:=ANSISQL, _
        ODBCPassThrough:=ODBCPassThrough

End Sub

Private Function pvtPopulateFromRecordSet(Optional RecordSet 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 ANSISQL As Variant, Optional ODBCPassThrough As Variant) As VBOFCollection
Attribute pvtPopulateFromRecordSet.VB_Description = "Sets the internally managed RecordSet"
' Sets a VBOFCollection object which has been
'   instantiated as a collection of objects
'   represented by the contents of RecordSet
' Note: use of this method requires that the
'   caller maintain all of the necessary object
'   containment information, since VBOFCollection
'   is unaware of the techniques used to derive the
'   contents of RecordSet
'
' Parameter Description:
'       see VBOFObjetManager.ManageCollection

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(RecordSet) Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.pvtPopulateFromRecordSet' method because the 'RecordSet:=' parameter is mssing."
        Set pvtPopulateFromRecordSet = Nothing
    End If

' test Sample for Database-readiness
    If Not IsMissing(Sample) Then
        If (Sample.ObjectDataSource = "" Or Err = 438) Then
            pvtCollectionEmulationMode = True
        End If
    End If

    pvtReceiveGeneralParameters _
        Database:=Database, _
        Sample:=Sample, _
        Parent:=Parent, _
        WhereClause:=WhereClause, _
        OrderByClause:=OrderByClause, _
        ANSISQL:=ANSISQL, _
        ODBCPassThrough:=ODBCPassThrough, _
        SQL:=SQL

' reference the RecordSet containing the desired rows
    Set pvtRecordSet = RecordSet

' create the objects from the contents of the RecordSet
    Set pvtCollection = _
        pvtInstantiateObjectsFromRecordSet( _
            RecordSet:=pvtRecordSet, _
            Collection:=pvtCollection)

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has instantiated a collection of objects from a user-defined RecordSet.  " & _
            "Object count=" & pvtCollection.Count
    End If
#End If

' trigger the "PopulatedFromRecordSet" event for Me
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Event:="PopulatedFromRecordSet"
#End If

    Set pvtPopulateFromRecordSet = Me
End Function

Public Function RecordSet() As RecordSet
Attribute RecordSet.VB_Description = "Returns the underlying RecordSet object"
' Returns a DataControl-ready RecordSet object
'   which pertains to the collection of objects
'   instantiated and contained within this
'   VBOFCollection

    If pvtCollectionEmulationMode Then
        Set RecordSet = Nothing
        Exit Function
    End If

    Set RecordSet = pvtRecordSet
End Function

Public Function SQLStatement() As String
Attribute SQLStatement.VB_Description = "Returns the most recently used SQL statement"
    SQLStatement = pvtSQLStatement
End Function

Public Function Refresh() As VBOFCollection
Attribute Refresh.VB_Description = "Refreshes the internally managed RecordSet which equates to the rows of the table which were used to instantiate the contained items.  Returns the refreshed VBOFCollection"
' Return a refreshed VBOFCollection, using again
'   the same SQL-oriented information used previously
'   to generate the current VBOFCollection state.
' Note: users of the method "pvtPopulateFromRecordSet"
'   should not use this method

    On Local Error Resume Next

' bullet-proofing
    If pvtRecordSetProvidedByUser Then
        pvtErrorMessage TypeName(Me) & " cannot process the '.Refresh' method because the RecordSet used to instantiate the objects was provided by the user via the '.pvtPopulateFromRecordSet' method."
        Set Refresh = Me
        GoTo Refresh_Exit
    End If

' refresh the Collection
    If pvtCollectionEmulationMode Then
        Set Refresh = Me
    Else
        Set Refresh = _
            pvtPopulateFromDatabase()
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has refreshed its collection of objects (.Refresh).  " & _
            "Object count=" & pvtCollection.Count
    End If
#End If

Refresh_Exit:
' trigger the "Refreshed" event for Me
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Event:="Refreshed"
#End If

    Exit Function
End Function

Public Function Remove(Optional Item As Variant, Optional Key As Variant, Optional NoDelete As Variant, Optional CleanUpMode As Variant, Optional CollectionEventNoDelete As Variant) As VBOFCollection
Attribute Remove.VB_Description = "Removes the item from the VBOFCollection"
' Remove the Item from the VBOFCollection and
'   return the VBOFCollection
' Note: if a Table is supporting the Collection,
'   then the VBOF automatic containment link to
'   the contained object (Me.Parent) is also severed
'   (unless CleanUpMode:=True).
'   See also, the method "pvtEmptyCollection"

    Dim tempCountOfParentLinksToItem As Long
    Dim tempSuppressDelete As Boolean
    Dim tempPvtDeleteExecuted As Boolean
    Dim tempCleanUpMode As Boolean
    Dim tempCollectionEventNoDelete As Boolean

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Item) Then
        Remove = Me
        Exit Function
    End If
    tempSuppressDelete = False
    If Not IsMissing(NoDelete) Then
        tempSuppressDelete = NoDelete
    End If
    tempCleanUpMode = False
    If Not IsMissing(CleanUpMode) Then
        tempCleanUpMode = CleanUpMode
    End If
    tempCollectionEventNoDelete = False
    If Not IsMissing(CollectionEventNoDelete) Then
        tempCollectionEventNoDelete = CollectionEventNoDelete
    End If

' sever the link from pvtParent to Item
    If Not pvtCollectionEmulationMode _
    And Not tempSuppressDelete Then
        pvtDeleteParentLinksToItem _
            Child:=Item, _
            Parent:=pvtParent
    End If

' remove the reference from the
'   pvtDBGridBookmarkArray
    pvtDBGridBookmarkArrayDeleteRowIndex ( _
        pvtDBGridRowIndexAtObjectID _
            (CStr(Item.ObjectID)))

' remove Item from the Collection
    pvtCollection.Remove _
        CollectionIndex(Item)

' trigger the "RemovedItem" event to other Collections
#If NoEventMgr = False Then
    If Not CleanUpMode Then
        TriggerCollectionEvent _
            Object:=Item, _
            Event:="RemovedItem", _
            NoDelete:=tempCollectionEventNoDelete
    End If
#End If

' if not operating in Collection-emulation mode
    If Not pvtCollectionEmulationMode _
    And Not tempCleanUpMode _
    Then

' check for orphan and other conditions necessary before
'   actually removing an Item from the database
'   (if not operating in NoDelete mode,
'   and if the AutoDeleteOrphans option is enabled,
'   and if the Item actually appears in the
'   RecordSet)
        If Not tempSuppressDelete _
        And Me.AutoDeleteOrphans _
        And Not pvtPositionRecordSetToItem _
                (Item:=Item) Is Nothing _
        And pvtIsAnOrphan _
                (Item:=Item) _
        Then

' delete Item from the database
'   and free the Item
            pvtDBDelete

' trigger the "RemovedItem" event for the new object
'   to any other listeners
#If NoEventMgr = False Then
            If Not CleanUpMode Then
                TriggerObjectEvent _
                    Object:=Item, _
                    Event:="RemovedItem"
            End If
#End If

' else, just Refresh the current RecordSet to
'   reflect the detached Item
        ElseIf Not pvtRecordSetProvidedByUser Then
            Refresh
        End If
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has removed an object from the collection.  ObjectType=" & _
            TypeName(Item) & _
            ", ObjectID=" & _
            Item.ObjectID
    End If
#End If

    Set Remove = Me
End Function

Private Function pvtCountOfParentLinksToItem(Optional Parent As Variant, Optional Child As Variant) As Long
' Return the number of Parent links exist for
'   the specified Child object

    Dim SQLStatement As String
    Dim tempRecordSet As RecordSet

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Parent) _
    Or IsMissing(Child) _
    Or pvtCollectionEmulationMode Then
        pvtCountOfParentLinksToItem = -1
        Exit Function
    End If

    Err = 0

' build the SQL statement to perform the Count
    SQLStatement = _
        "SELECT COUNT(*) FROM " & ObjectDataSource() & " " & _
        "WHERE ToObjectType = '" & _
        TypeName(Child) & "' AND ToObjectID = " & _
        Child.ObjectID

' check for non-existent Object
    If Err = 91 Then
        pvtCountOfParentLinksToItem = 0
        Exit Function
    End If

    Set tempRecordSet = _
        pvtDatabase. _
            OpenRecordset( _
                SQLStatement, _
                dbOpenDynaset + pvtODBCPassThrough)

    If Err <> 0 And Err <> 91 Then
        pvtErrorMessage _
            TypeName(Me) & " received a database error while attempting to count the object containment links (Select Count(*))."
        pvtCountOfParentLinksToItem = 0
    Else
        pvtCountOfParentLinksToItem = _
            tempRecordSet(0)
    End If

    Set tempRecordSet = Nothing
End Function

Private Function pvtDeleteParentLinksToItem(Optional Parent As Variant, Optional Child As Variant) As Long
' Remove the link between the Parent and Child

    Dim SQLStatement As String

    On Local Error Resume Next

    If pvtCollectionEmulationMode Then
        pvtDeleteParentLinksToItem = True
        Exit Function
    End If

    Err = 0

' delete the row from the VBObjectFrameworkObjectLinks table
    SQLStatement = _
        "DELETE FROM " & ObjectDataSource() & " WHERE FromObjectType = '" & _
        TypeName(Parent) & "' AND FromObjectID = " & _
        Parent.ObjectID & " AND ToObjectType = '" & _
        TypeName(Child) & "' AND ToObjectID = " & _
        Child.ObjectID

' check for illegal Object
    If Err = 91 Then
        pvtDeleteParentLinksToItem = False
        Exit Function
    End If

    pvtDatabase.Execute SQLStatement, pvtODBCPassThrough
    If Err <> 0 And Err <> 3078 And Err <> 91 Then
        pvtErrorMessage TypeName(Me) & " received a database error while attempting to remove an object containment link (Delete)."
        pvtDeleteParentLinksToItem = False
        Exit Function
    End If

    pvtDeleteParentLinksToItem = True
End Function

Public Function Replace(Optional Item As Variant, Optional ReplaceWith As Variant) As VBOFCollection
Attribute Replace.VB_Description = "Replaces the item with the specified ReplaceWith item in the collection and in the associated Data Source"
' Replace the specified Item with the ReplaceWith
'   Item, then return the VBOFCollection

    Dim ItemIndex As Long

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Item) _
    Or IsMissing(ReplaceWith) Then
        Set Replace = Me
        GoTo Replace_Exit
    End If

' there are two ways to handle a Replace:
'   1) replace the object in-place
'       (non Collection-emulation mode, only),
'   2) replace the object with another
'
' process the replacement in-place:
    If Item.ObjectID = ReplaceWith.ObjectID _
    And Not pvtCollectionEmulationMode Then

' position to the correct record in the RecordSet.
'   Note:  with non-DataControl uses of VBOFCollection,
'   it is possible for the correlation to be lost
'   between the current record of the RecordSet and
'   the user-selected object.
' position the RecordSet to the Item
        If pvtPositionRecordSetToItem(Item:=Item) _
            Is Nothing _
        Then
            Set Replace = Me
            GoTo Replace_Exit
        End If

' initiate the RecordSet.Edit
        pvtRecordSet.Edit

' have ReplaceWith initialize the RecordSet
        ReplaceWith. _
            ObjectInitializeRecordSet _
                pvtRecordSet
        If Err = pvtReceiverDoesNotSupportThisMethod Then
            pvtErrorMessage "Class Module '" & TypeName(ReplaceWith) & "' does not support the method 'InitializeRecordSet'." & vbCrLf & "Object cannot be supported by " & TypeName(Me) & " without this method."
        End If

' post the updates to the database
        pvtRecordSet.Update

' execute Me.Refresh
        Refresh

        Set Replace = Me
        GoTo Replace_Exit
    End If

' else, Item must be removed and replaced with ReplaceWith.
' save the position of Item in the Collection
    ItemIndex = CollectionIndex(Item)

' remove Item from the RecordSet and the Collection
    Remove _
        Item:=Item, _
        Key:=CStr(Item.ObjectID), _
        NoDelete:=False, _
        CollectionEventNoDelete:=True

' free Item
    Set Item = Nothing

' add the ReplaceWith item
    If ItemIndex > 0 Then
        Add _
            Item:=ReplaceWith, _
            Parent:=pvtParent, _
            After:=(ItemIndex - 1)
    Else
        Add _
            Item:=ReplaceWith, _
            Parent:=pvtParent
    End If

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has replaces an object in the collection.  Original ObjectType=" & _
            TypeName(Item) & _
            ", ObjectID=" & _
            Item.ObjectID & " replaced with ObjectType=" & _
            TypeName(ReplaceWith) & _
            ", ObjectID=" & _
            ReplaceWith.ObjectID
    End If
#End If

Replace_Exit:
' trigger the "Replaced" event for Me
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Object:=Item, _
        Event:="ReplacedItem"
#End If

    Set Replace = Me
End Function

Public Function Commit() As Long
Attribute Commit.VB_Description = "Private"
' Commit each Object in the collection
' Note: although this method is Public, it
'   should not be executed by any object
'   other than the governing
'   VBOFObjectManager

    Dim tempObject As Object

    On Local Error Resume Next

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has begun 'Commit' processing"
    End If
#End If

' process each object
    For Each tempObject In pvtCollection

' position the RecordSet to correspond to the
'   current object
        pvtRecordSet.FindFirst _
            "ObjectID = " & _
            tempObject.ObjectID

        If Err = 0 Then
            pvtRecordSet.Edit

' allow the object to populate the RecordSet
            tempObject. _
                ObjectInitializeRecordSet _
                    RecordSet:=pvtRecordSet

            pvtRecordSet.Update
        End If

    Next tempObject

#If NoDebugMode = False Then
    If pvtVBOFObjectManager.DebugMode Then
        pvtVBOFObjectManager.DisplayDebugMessage _
            TypeName(Me) & ", ObjectID=" & Me.ObjectID & ", has completed 'Commit' processing"
    End If
#End If

' trigger the "Committed" event for the new object
#If NoEventMgr = False Then
    TriggerCollectionEvent _
        Event:="Committed"
#End If

    Set tempObject = Nothing
End Function
Private Function pvtPositionRecordSetToItem(Optional Item As Variant) As Variant
Attribute pvtPositionRecordSetToItem.VB_Description = "(Private) internal function"
' Position to the RecordSet row which equates to
'   the specified Item

    Dim I As Long
    Dim tempItemFound As Boolean

    On Local Error Resume Next
    Err = 0

' check the current record first
'   (performance feature)
    If Not pvtRecordSet.BOF _
    And Not pvtRecordSet.EOF _
    And pvtRecordSet.RecordCount > 0 Then
        If pvtRecordSet("ObjectID") = CStr(Item.ObjectID) Then
            Set pvtPositionRecordSetToItem = Item
            Exit Function
        End If
    End If

' else, .FindFirst
'    pvtRecordSet.MoveFirst
    pvtRecordSet.FindFirst _
        "ObjectID = " & CStr(Item.ObjectID)

' Caution: the application's responses to the
'   RecordSet might distort the following
'   processing
    tempItemFound = _
        Not pvtRecordSet.NoMatch

' This is potentially a very dangerous area (see
'   preceeding comment).  Make one final check
'   before returning True
    If Not tempItemFound _
    Or pvtRecordSet("ObjectID") <> CStr(Item.ObjectID) Then
        Set pvtPositionRecordSetToItem = Nothing
    Else
        Set pvtPositionRecordSetToItem = Item
    End If
End Function

Private Function TriggerObjectEvent(Optional Object As Variant, Optional Event As Variant) As Boolean
' Pass-through to ObjectManager

#If NoEventMgr = False Then
    pvtVBOFObjectManager. _
        TriggerObjectEvent _
            Event:=Event, _
            Object:=Object
#End If

End Function

Private Function TriggerCollectionEvent(Optional Object As Variant, Optional Event As Variant, Optional NoDelete As Variant) As Boolean
' Pass-through to ObjectManager

#If NoEventMgr = False Then
    pvtVBOFObjectManager. _
        TriggerCollectionEvent _
            Event:=Event, _
            Object:=Object, _
            Collection:=Me, _
            NoDelete:=NoDelete
#End If

End Function


Private Sub Class_Initialize()
Attribute Class_Initialize.VB_Description = "Private"

    Set pvtCollection = New Collection
    Set pvtSample = Nothing
    Set pvtParent = Nothing
    Set pvtDatabase = Nothing
    Set pvtRecordSet = Nothing
    Set pvtVBOFObjectManager = Nothing
    Set pvtMostRecentlyAddedObject = Nothing
    Set pvtVBOFListBoxWrapper = Nothing
    Set pvtListBox = Nothing

    pvtANSISQL = False
    pvtODBCPassThrough = 0
    pvtSQLStatement = ""
    pvtWhereClause = ""
    pvtDBHasBeenReferenced = False
    pvtCollectionEmulationMode = True
    pvtRecordSetProvidedByUser = False
    pvtSQLStatementProvidedByUser = False
    pvtDBGridBookmarkArrayAvailable = False
    pvtAutoDeleteOrphansHasBeenInitialized = False

    ObjectID = -1
End Sub
Public Property Get WhereClause() As String
Attribute WhereClause.VB_Description = "Sets the WhereClause property"
' Returns the current WhereClause value

    WhereClause = pvtWhereClause
End Property

Public Property Let WhereClause(WhereClause As String)
' Set the WhereClause to be used in future SQL
'   Select statements
' Note: this step is not necessarily required of
'   the application

    pvtReceiveGeneralParameters _
        WhereClause:=WhereClause

    pvtCollectionEmulationMode = False
End Property

Public Property Get OrderByClause() As String
Attribute OrderByClause.VB_Description = "Sets the OrderByClause property"
' Returns the current OrderByClause

    OrderByClause = pvtOrderByClause
End Property

Public Property Let OrderByClause(OrderByClause As String)
' Set the OrderByClause to be used in future SQL Select
'   statements
' Note: this step is not necessarily required of the user

    pvtReceiveGeneralParameters _
        OrderByClause:=OrderByClause

    pvtCollectionEmulationMode = False
End Property

Public Property Get Owner() As Variant
' Return my owner

MsgBox "Shouldn't be using 'Owner'.  Use 'Parent' instead."
'    On Local Error Resume Next
'
'    If pvtOwner Is Nothing Or Err = 424 Then
'        Set Owner = Nothing
'    Else
'        Set Owner = pvtOwner
'    End If
End Property

Public Property Set Parent(anObject As Variant)
    Set pvtParent = anObject
End Property

Private Sub Class_Terminate()
Attribute Class_Terminate.VB_Description = "Private"

    On Local Error Resume Next

    pvtCloseRecordSet

#If NoEventMgr = False Then
    pvtVBOFObjectManager. _
        UnRegisterForAllEvents _
        RegisterObject:=Me
#End If

    If Not pvtVBOFObjectManager Is Nothing Then
        pvtVBOFObjectManager.EmptyCollection _
            Collection:=Me, _
            CleanUpMode:=True
    End If

End Sub




Public Function ObjectEventCallBack(Optional Event As Variant, Optional Object As Variant, Optional NoDelete As Variant) As Long
Attribute ObjectEventCallBack.VB_Description = "Private"
' This method is typically invoked when another
'   VBOFCollection is changing an
'   item in itself

    Dim tempObject As Object
    Dim tempUCaseEvent As String
    Dim tempNoDelete As Boolean

    tempUCaseEvent = UCase$(Event)

' (performance feature)
' check for empty Collection
    If pvtCollection.Count = 0 Then
        Exit Function
    End If

' (performance feature)
' check the TriggerObject's first object's type
'   against my first object's type
    If TypeName(Object) <> _
        TypeName(pvtCollection.Item(1)) _
    Then
        Exit Function
    End If

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

' scan the objects contained herein,
'   look for the item about which the trigger
'   is associated
    For Each tempObject In pvtCollection

        If tempObject.ObjectID = Object.ObjectID Then

            If tempUCaseEvent = "REMOVEDITEM" _
            And Not tempNoDelete Then
                pvtCollection.Remove _
                    CollectionIndex(Item:=tempObject)

' tell any Object Event listeners of the change to
'   the Collection
'   (like a GUI, for example)
                TriggerObjectEvent _
                    Object:=Object, _
                    Event:=Event
            End If

            If tempUCaseEvent = "REPLACEDITEM" Then

' tell any Object Event listeners of the change to
'   the Collection
'   (like a GUI, for example)
                TriggerObjectEvent _
                    Object:=Object, _
                    Event:=Event
            End If
       End If

    Next tempObject

    Set tempObject = Nothing
End Function