' Cannot be distributed or sold without permission
'
' VBOFDBGridWrapper 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
' VBOFDBGridWrapper is a wrapper class for
' providing automatic interfacing between a
' DBGrid VB control and an underlying
' VBOFCollection
Private pvtVBOFObjectManager As VBOFObjectManager
Private pvtCollection As VBOFCollection
Private pvtSample As Variant
Private pvtParent As Variant
Private pvtDBGrid As Variant
Private pvtSupportedTypeNames As String
Public ObjectID As Long
Public Property Get Collection() As Variant
Attribute Collection.VB_Description = "Sets the underlying VBOFCollection"
' Returns my VBOFCollection object
Set Collection = pvtCollection
End Property
Private Function pvtIsFullyInitialized(Optional Collection As Variant, Optional DBGrid As Variant, Optional Verbose As Variant) As Boolean
If Not pvtVerifyCollection( _
Collection:=Collection, _
Verbose:=Verbose) _
Then
pvtIsFullyInitialized = False
Exit Function
End If
If Not pvtVerifyDBGrid( _
DBGrid:=DBGrid, _
Verbose:=Verbose) _
Then
pvtIsFullyInitialized = False
Exit Function
End If
pvtIsFullyInitialized = 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
Else
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
Public Property Let Bookmark(Bookmark As Variant)
Attribute Bookmark.VB_Description = "Sets the Bookmark property of the DBGrid"
' Sets the Bookmark value of the DBGrid
' Using this method:
' MyDBGridWrapper.Bookmark = _
' MyBookMark
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
pvtCollection. _
pvtDBGridBookmark _
(DBGrid:=pvtDBGrid) = _
Bookmark
End Property
Public Property Get Bookmark() As Variant
' Returns the Bookmark value of the DBGrid
' Using this method:
' Set MyBookmark = _
' MyDBGridWrapper.Bookmark
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Bookmark = _
pvtCollection. _
pvtDBGridBookmark _
(DBGrid:=pvtDBGrid)
End Property
Public Property Set BookmarkObject(Object As Variant)
Attribute BookmarkObject.VB_Description = "Set the Bookmark property of the DBGrid to equate to the specified object"
' Sets the Bookmark of the DBGrid to the position
' of Object
' Using this method:
' Set MyDBGridWrapper.BookmarkObject = _
' MyObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set pvtCollection. _
pvtDBGridBookmarkObject _
(DBGrid:=pvtDBGrid) = _
Object
End Property
Public Property Get BookmarkObject() As Variant
' Returns the Object at the Bookmark value of the
' DBGrid
' Using this method:
' MyObject = _
' MyDBGridWrapper. BookmarkObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set BookmarkObject = _
pvtCollection. _
pvtDBGridBookmarkObject _
(DBGrid:=pvtDBGrid)
End Property
Public Property Set DBGrid(DBGrid As Variant)
Attribute DBGrid.VB_Description = "Sets the underlying DBGrid"
pvtVerifyDBGrid _
DBGrid:=DBGrid
End Property
Public Property Set Collection(Collection As Variant)
If Collection Is Nothing Then
Set pvtCollection = Nothing
Exit Property
End If
pvtVerifyCollection _
Collection:=Collection, _
Verbose:=True
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
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:="DBGrid")
End Function
Private Function pvtUseDBGrid(Optional DBGridParm As Variant, Optional Verbose As Variant) As Variant
Set pvtUseDBGrid = _
ObjectManager. _
pvtWrapperUseControl( _
ControlParm:=DBGridParm, _
pvtControl:=pvtDBGrid, _
SupportedNames:=pvtSupportedTypeNames, _
Verbose:=Verbose, _
WrapperName:="DBGrid")
End Function
Private Function pvtVerifyCollection(Optional Collection As Variant, Optional Verbose As Variant) As Boolean
pvtVerifyCollection = _
ObjectManager. _
pvtWrapperVerifyCollection( _
Collection:=Collection, _
pvtCollection:=pvtCollection, _
Verbose:=Verbose, _
WrapperName:="DBGrid")
End Function
Public Function Rebind(Optional Collection As Variant, Optional DBGrid As Variant) As Boolean
Attribute Rebind.VB_Description = "Rebinds the VBOFDBGridWrapper"
' Rebinds the Wrapper to a Collection or DBGrid
' after having changed the assignment of either.
' For example, in the following scenario, the
' VBOFSDBGridWrapper must be rebound because the
' VBOFCollection has been significantly altered:
'
' Dim pvtAddresses as VBOFCollection
' Dim pvtPerson as Person
' Dim MyDBGridWrapper as VBOFDBGridWrapper
' Set MyDBGridWrapper = _
' ObjectManager.NewVBOFDBGridWrapper ( _
' Collection:=pvtAddresses, _
' DBGrid:=MyDBGrid)
'
' 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
' MyDBGridWrapper.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
If Not IsMissing(DBGrid) Then
If TypeName(DBGrid) <> "DBGrid" Then
pvtErrorMessage TypeName(Me) & " cannot process the '.Rebind' method because the 'DBGrid:=' parameter is not a Visual Basic DBGrid control. Please use a VBOF Wrapper for the " & TypeName(DBGrid) & " control (or request the development of one.)"
Rebind = False
Exit Function
End If
End If
If Not pvtIsFullyInitialized( _
Collection:=Collection, _
DBGrid:=DBGrid, _
Verbose:=False) _
Then
Exit Function
End If
pvtDBGrid.Refresh
Rebind = True
End Function
Public Function Refresh(Optional DisplayOnly As Variant) As Boolean
Attribute Refresh.VB_Description = "Refreshes the VBOFDBGridWrapper, the VBOFCollection and the DBGrid"
' Refreshes the display of the DBGrid
' Using this method:
' MyDBGridWrapper.Refresh
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Function
End If
If Not IsMissing(DisplayOnly) Then
If DisplayOnly Then
Else
Set Collection = _
pvtCollection.Refresh
End If
Else
End If
pvtDBGrid.Refresh
Refresh = True
End Function
Private Function pvtVerifyDBGrid(Optional DBGrid As Variant, Optional Verbose As Variant) As Boolean
pvtVerifyDBGrid = _
ObjectManager. _
pvtWrapperVerifyControl( _
Control:=DBGrid, _
pvtControl:=pvtDBGrid, _
Verbose:=Verbose)
End Function
Public Property Get DBGrid() As Variant
Set DBGrid = pvtDBGrid
End Property
Public Function SetNumberOfRows() 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 is optional and can be coded as
' follows:
' Private Sub Form_Load()
' MyDBGridWrapper.SetNumberOfRows
' End Sub
On Local Error Resume Next
If Not pvtIsFullyInitialized() _
Then
Exit Function
End If
SetNumberOfRows = _
pvtCollection. _
pvtDBGridSetNumberOfRows _
(DBGrid:=pvtDBGrid)
End Function
Public Function Unbind() As Boolean
Set pvtCollection = Nothing
Set pvtDBGrid = Nothing
Set pvtVBOFObjectManager = Nothing
End Function
Public Function UnboundAddData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional NewRowBookmark As Variant, Optional Sample As Variant, Optional Parent As Variant) As Variant
Attribute UnboundAddData.VB_Description = "Processes the DBGrid UnboundAddData event procedure"
' 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:
' 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 VBOFDBGridWrapper 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 VBOFDBGridWrapper 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)
' Dim tempSample as New MyClass
' MyDBGridWrapper.UnboundAddData _
' RowBuf:=RowBuf, _
' NewRowBookmark:=NewRowBookmark, _
' Sample:=tempSample
' End Sub
Dim tempParent As VBOFCollection
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized( _
DBGrid:=DBGrid) _
Then
Exit Function
End If
If IsMissing(RowBuf) Then
pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundAddData' method for this object because the 'RowBuf:=' parameter is missing."
Exit Function
End If
If IsMissing(NewRowBookmark) Then
pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundAddData' method for this object because the 'NewRowBookmark:=' parameter is missing."
Exit Function
End If
If Not pvtSetSample( _
Sample:=Sample, _
MethodName:="UnboundAddData") Then
Set UnboundAddData = Nothing
GoTo UnboundAddData_Exit
End If
' pick a value for Parent
Set tempParent = pvtCollection.Parent
If Not IsMissing(Parent) Then
Set tempParent = Parent
End If
Set UnboundAddData = _
pvtCollection. _
pvtDBGridUnboundAddData( _
DBGrid:=pvtDBGrid, _
RowBuf:=RowBuf, _
NewRowBookmark:=NewRowBookmark, _
Sample:=Sample, _
Parent:=tempParent)
Refresh
UnboundAddData_Exit:
Exit Function
End Function
Public Function UnboundWriteData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional WriteLocation As Variant) As Variant
Attribute UnboundWriteData.VB_Description = "Processes the DBGrid UnboundWriteData event procedure"
' Processes the UnboundWriteData event of the DBGrid.
'
' Parameters:
' 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(ByVal RowBuf As RowBuffer, WriteLocation As Variant)
' MyDBGridWrapper.UnboundWriteData _
' RowBuf:=RowBuf, _
' WriteLocation:=WriteLocation
' End Sub
On Local Error Resume Next
If Not pvtIsFullyInitialized( _
DBGrid:=DBGrid) _
Then
Exit Function
End If
Set UnboundWriteData = _
pvtCollection. _
pvtDBGridUnboundWriteData( _
DBGrid:=pvtDBGrid, _
RowBuf:=RowBuf, _
WriteLocation:=WriteLocation)
Refresh
UnboundWriteData_Exit:
Exit Function
End Function
Public Function UnboundReadData(Optional DBGrid As Variant, Optional RowBuf As Variant, Optional StartLocation As Variant, Optional ReadPriorRows As Variant) As Long
Attribute UnboundReadData.VB_Description = "Processes the DBGrid UnboundReadData event procedure"
' Populates the DBGrid with one row of information
' for each object in the associated
' 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)
' MyDBGridWrapper.UnboundReadData _
' RowBuf:=RowBuf, _
' StartLocation:=StartLocation, _
' ReadPriorRows:=ReadPriorRows
' End Sub
On Local Error Resume Next
' bullet-proofing
If IsMissing(RowBuf) Then
pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundReadData' method for this object because the 'RowBuf:=' parameter is missing."
Exit Function
End If
If IsMissing(StartLocation) Then
pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundReadData' method for this object because the 'StartLocation:=' parameter is missing."
Exit Function
End If
If IsMissing(ReadPriorRows) Then
pvtErrorMessage TypeName(Me) & " cannot process the '.UnboundReadData' method for this object because the 'ReadPriorRows:=' parameter is missing."
Exit Function
End If
If Not pvtIsFullyInitialized( _
DBGrid:=DBGrid) _
Then
Exit Function
End If
UnboundReadData = _
pvtCollection. _
pvtDBGridUnboundReadData( _
DBGrid:=pvtDBGrid, _
RowBuf:=RowBuf, _
StartLocation:=StartLocation, _
ReadPriorRows:=ReadPriorRows)
End Function
Public Function UnboundDeleteRow(Optional DBGrid As Variant, Optional Bookmark As Variant) As Long
Attribute UnboundDeleteRow.VB_Description = "Processes the DBGrid UnboundDeleteRow event procedure"
' Removes the Bookmarked Object from the DBGrid
' and from associated VBOFCollection.
' Returns the number of rows currently ino the
' DBGrid
'
' Note: this method should be coded in the
' DBGrid's UnboundReadData Event Procedure,
' as follows:
'
' Private Sub DBGrid1_UnboundDeleteRow(ByVal Bookmark As RowBuffer)
' MyDBGridWrapper.UnboundDeleteRow _
' Bookmark:=Bookmark
' End Sub
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."
