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

Text File | 1996-11-20 | 13.9 KB | 491 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "VBOFRecordSetWrapper"
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
'
' VBOFRecordSetWrapper is a supplemental GUI
'   Control Wrapper for Microsoft Visual Basic 4.0.
'   It is valid only in conjunction with the
'   following Classes Modules:
'       VBOFCollection
'       VBOFObjectLink
'       VBOFObjectManager

' VBOFRecordSetWrapper is a wrapper class for
'   providing automatic interfacing between a
'   RecordSet VB control and an underlying
'   VBOFCollection

Private pvtVBOFObjectManager As VBOFObjectManager
Private pvtCollection As VBOFCollection
Private pvtDataControl As Variant
Private pvtRecordSetSupportedTypeNames As String
Private pvtCollectionSupportedTypeNames As String

Public ObjectID As Long

Public Property Get AbsolutePositionObject() As Variant
' Returns the object at the AbsolutionPosition (+ 1)
'   of the underlying RecordSet

    Dim tempLong As Long

    On Local Error Resume Next

    tempLong = AbsolutePosition

    If tempLong >= 0 Then
        Set AbsolutePositionObject = _
            pvtCollection.Item _
                (tempLong + 1)
    Else
        Set AbsolutePositionObject = _
            Nothing
    End If
End Property

Public Property Set AbsolutePositionObject(Object As Variant)
' Sets the AbsolutionPosition (+ 1) of the
'   underlying RecordSet to correspond to the
'   object

    Dim tempLong As Long

    On Local Error Resume Next

    tempLong = _
        pvtCollection.CollectionIndex _
            (Item:=Object)

    If tempLong > 0 Then
        AbsolutePosition = tempLong - 1
    End If
End Property



Public Function pvtCloseRecordSet() As Long
' Closes the underlying RecordSet

' bullet-proofing
    If Not pvtVerifyCollection() Then
        pvtCloseRecordSet = -1
        Exit Function
    End If

    pvtCloseRecordSet = _
        pvtCollection. _
            pvtCloseRecordSet()
End Function
Public Function pvtCloneRecordSet() As RecordSet
' Returns a cloned RecordSet of the underlying
'   RecordSet object

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set pvtCloneRecordSet = Nothing
        Exit Function
    End If

    Set pvtCloneRecordSet = _
        pvtCollection.pvtCloneRecordSet()
End Function


Public Property Get Collection() As Variant
Attribute Collection.VB_Description = "Maps to the underlying VBOFCollection"
' Returns my VBOFCollection object

    Set Collection = pvtCollection
End Property
Public Property Set Collection(Collection As Variant)
    Set pvtCollection = Collection
End Property



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

    Set ObjectManager = pvtVBOFObjectManager
End Property
Public Property Set ObjectManager(anObjectManager As VBOFObjectManager)
' Set my reference to the VBOFObjectManager

    Set pvtVBOFObjectManager = anObjectManager
End Property

Public Function PositionToItem(Optional Item As Variant) As Variant
Attribute PositionToItem.VB_Description = "Moves the underlying RecordSet to the position equating to the specified Item"
' Positions the underlying RecordSet to the
'   specifed Item and returns the Item

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set PositionToItem = Nothing
        Exit Function
    End If

    Set PositionToItem = _
        pvtCollection. _
            pvtRecordSetPositionToItem _
                    (Item:=Item)
End Function

Public Function PositionToObject(Optional Object As Variant) As Variant
Attribute PositionToObject.VB_Description = "Moves the underlying RecordSet to the position equating to the specified Object"
' Positions the underlying RecordSet to the
'   specifed Item and returns the Item

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set PositionToItem = Nothing
        Exit Function
    End If

    Set PositionToObject = _
        pvtCollection. _
            pvtRecordSetPositionToItem _
                    (Item:=Object)
End Function


Private Function pvtVerifyCollection() As Boolean
    If pvtUseCollection(CollectionParm:=pvtCollection) _
    Is Nothing Then
        pvtVerifyCollection = False
    Else
        pvtVerifyCollection = True
    End If
End Function


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

Private Function pvtUseCollection(Optional CollectionParm As Variant, Optional Verbose As Variant) As Variant
    Set pvtUseCollection = _
        ObjectManager. _
            pvtWrapperUseCollection( _
                CollectionParm:=CollectionParm, _
                pvtCollection:=pvtCollection, _
                Verbose:=Verbose, _
                WrapperName:="RecordSet")
End Function


Public Function Rebind(Optional Collection As Variant, Optional DataControl As Variant) As Variant
Attribute Rebind.VB_Description = "Rebinds the VBOFCollection  to the Wrapper"
' Rebinds the Wrapper to a Collection or DataControl
'   after having changed the assignment of either.
'   For example, in the following scenario, the
'   VBOFRecordSetWrapper must be rebound because
'   the VBOFCollection has been significantly altered:
'
'   Dim pvtAddresses as VBOFCollection
'   Dim pvtPerson as Person
'   Dim MyRecordSetWrapper as VBOFRecordSetWrapper
'   Set MyRecordSetWrapper = _
'       ObjectManager.NewVBOFRecordSetWrapper ( _
'           Collection:=pvtAddresses)
'
' the following line alters the state of the data
' in-effect at the time of the above binding
'   Set pvtAddresses = pvtPerson.Addresses
' rebind the Wrapper
'   MyRecordSetWrapper.Rebind _
'           Collection:=pvtAddresses

' bullet-proofing
    If Not IsMissing(Collection) Then
        If TypeName(Collection) <> "VBOFCollection" Then
            pvtErrorMessage TypeName(Me) & " cannot process the '.Rebind' method because the 'Collection:=' parameter is not a VBOFCollection."
            Rebind = False
            Exit Function
        End If
    End If

' bind to the Collection
    Set Me.Collection = _
        Collection

    Rebind = True
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

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set RecordSet = Nothing
        Exit Function
    End If

    Set RecordSet = _
        pvtCollection.RecordSet
End Function

Public Property Get AbsolutePosition() As Long
Attribute AbsolutePosition.VB_Description = "Maps to the AbsolutePosition property of the underlying RecordSet object"
' Gets the RecordSet's AbsolutePosition
'   property

    On Local Error Resume Next

' bullet-proofing
    If Not pvtVerifyCollection() Then
        AbsolutePosition = -1
        Exit Property
    End If

    AbsolutePosition = _
        pvtCollection. _
            pvtRecordSetAbsolutePosition
End Property
Public Property Let AbsolutePosition(RecordNumber As Long)
' Sets the RecordSet's AbsolutePosition
'   property

    On Local Error Resume Next

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Exit Property
    End If

    pvtCollection. _
        pvtRecordSetAbsolutePosition = _
            RecordNumber
End Property

Public Function EOF() As Boolean
Attribute EOF.VB_Description = "Maps to the EOF property of the underlying RecordSet object"
' Returns a boolean, based on whether or not the
' underlying RecordSet is positioned at EOF

' bullet-proofing
    If Not pvtVerifyCollection() Then
        EOF = False
        Exit Function
    End If

    EOF = _
        pvtCollection. _
            pvtRecordSetEOF
End Function
Public Function FindFirst(Optional SearchCriteria As Variant) As Variant
Attribute FindFirst.VB_Description = "Executes the FindFirst method of the underlying RecordSet object"
' Searches the underlying RecordSet for the first
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set FindFirst = Nothing
        Exit Function
    End If

    Set FindFirst = _
        pvtCollection. _
            pvtRecordSetFindFirst _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindLast(Optional SearchCriteria As Variant) As Variant
Attribute FindLast.VB_Description = "Executes the FindLast method of the underlying RecordSet object"
' Searches the underlying RecordSet for the last
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set FindLast = Nothing
        Exit Function
    End If

    Set FindLast = _
        pvtCollection. _
            pvtRecordSetFindLast _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindPrevious(Optional SearchCriteria As Variant) As Variant
Attribute FindPrevious.VB_Description = "Executes the FindPrevious method of the underlying RecordSet object"
' Searches the underlying RecordSet for the previous
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set FindPrevious = Nothing
        Exit Function
    End If

    Set FindPrevious = _
        pvtCollection. _
            pvtRecordSetFindPrevious _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function FindNext(Optional SearchCriteria As Variant) As Variant
Attribute FindNext.VB_Description = "Executes the FindNext method of the underlying RecordSet object"
' Searches the underlying RecordSet for the next
'   record meeting the specified criteria
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set FindNext = Nothing
        Exit Function
    End If

    Set FindNext = _
        pvtCollection. _
            pvtRecordSetFindNext _
                (SearchCriteria:=SearchCriteria)
End Function

Public Function MoveFirst() As Variant
Attribute MoveFirst.VB_Description = "Executes the MoveFirst method of the underlying RecordSet object"
' Moves the underlying RecordSet to the first record
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set MoveFirst = Nothing
        Exit Function
    End If

    Set MoveFirst = _
        pvtCollection. _
            pvtRecordSetMoveFirst
End Function

Public Function MoveLast() As Variant
Attribute MoveLast.VB_Description = "Executes the MoveLast method of the underlying RecordSet object"
' Moves the underlying RecordSet to the Last record
'   and returns the object for that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set MoveLast = Nothing
        Exit Function
    End If

    Set MoveLast = _
        pvtCollection. _
            pvtRecordSetMoveLast
End Function
Public Function MoveToRecordNumber(Optional RecordNumber As Variant) As Variant
Attribute MoveToRecordNumber.VB_Description = "Moves the underlying RecordSet to the specified RecordNumber"
' Moves the underlying RecordSet to the specified
'   record (by number) and returns the object for
'   that row

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set MoveToRecordNumber = Nothing
        Exit Function
    End If

    Set MoveToRecordNumber = _
        pvtCollection. _
            pvtRecordSetMoveToRecordNumber _
                (RecordNumber:=RecordNumber)
End Function

Public Function RecordCount() As Long
Attribute RecordCount.VB_Description = "Returns the RecordCount property of the underlying RecordSet object"
' Returns the RecordCount property of the
' underlying RecordSet

' bullet-proofing
    If Not pvtVerifyCollection() Then
        RecordCount = -1
        Exit Function
    End If

    RecordCount = _
        pvtCollection. _
            pvtRecordSetRecordCount()
End Function

Public Function Refresh() As RecordSet
Attribute Refresh.VB_Description = "Refreshes the underlying RecordSet"
' Refresh the RecordSet

' Pass thru to pvtRefreshRecordSet()

' bullet-proofing
    If Not pvtVerifyCollection() Then
        Set Refresh = Nothing
        Exit Function
    End If

    Set Refresh = _
        Me.Collection.pvtRecordSetRefresh
End Function

Public Function Unbind() As Boolean

    Set pvtCollection = Nothing
    Set pvtVBOFObjectManager = Nothing

End Function


Public Function BOF() As Boolean
Attribute BOF.VB_Description = "Maps to the BOF property of the underlying RecordSet object"
' Returns a boolean, based on whether or not the
' underlying RecordSet is positioned at BOF

' bullet-proofing
    If Not pvtVerifyCollection() Then
        BOF = False
        Exit Function
    End If

    BOF = _
        pvtCollection. _
            pvtRecordSetBOF
End Function



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

    pvtRecordSetSupportedTypeNames = _
        "RecordSet DynaSet SnapShot"
    pvtCollectionSupportedTypeNames = _
        "VBOFCollection"

    Set pvtDataControl = Nothing
End Sub


Private Sub Class_Terminate()
Attribute Class_Terminate.VB_Description = "Private"
    If Not ObjectManager Is Nothing Then
        ObjectManager.TerminateObject _
            Object:=Me
    End If
End Sub