' Cannot be distributed or sold without permission
'
' VBOFListBoxWrapper 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
' VBOFListBoxWrapper is a wrapper class for
' providing automatic interfacing between a
' ListBox VB control and an underlying
' VBOFCollection
Private pvtVBOFObjectManager As VBOFObjectManager
Private pvtCollection As VBOFCollection
Private pvtListBox As Variant
Private pvtSupportedTypeNames As String
Public ObjectID As Long
Public Function Unbind() As Boolean
Set pvtCollection = Nothing
Set pvtListBox = Nothing
Set pvtVBOFObjectManager = Nothing
End Function
Public Function Rebind(Optional Collection As Variant, Optional ListBox As Variant) As Boolean
Attribute Rebind.VB_Description = "Rebinds the VBOFCollection and ListBox to the Wrapper"
' Rebinds the Wrapper to a Collection or ListBox
' after having changed the assignment of either.
' For example, in the following scenario, the
' VBOFDBGridWrapper must be rebound because the
' VBOFCollection has been significantly altered:
'
' Dim pvtAddresses as VBOFCollection
' Dim pvtPerson as Person
' Dim MyListBoxWrapper as VBOFListBoxWrapper
' Set MyListBoxWrapper = _
' ObjectManager.NewVBOFListBoxWrapper ( _
' Collection:=pvtAddresses, _
' ListBox:=MyListBox)
'
' 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
' MyListBoxWrapper.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(ListBox) Then
If TypeName(ListBox) <> "ListBox" _
And TypeName(ListBox) <> "ComboBox" _
Then
pvtErrorMessage TypeName(Me) & " cannot process the '.Rebind' method because the 'ListBox:=' parameter is not a Visual Basic ListBox control. Please use a VBOF Wrapper for the " & TypeName(ListBox) & " control (or request the development of one.)"
Rebind = False
Exit Function
End If
End If
If Not pvtIsFullyInitialized( _
Collection:=Collection, _
ListBox:=ListBox, _
Verbose:=False) _
Then
Exit Function
End If
' bind to the ListBox and Collection
If Not IsMissing(Collection) Then
If Not Collection Is Nothing Then
Set Me.Collection = _
Collection
End If
End If
If Not IsMissing(ListBox) Then
If Not ListBox Is Nothing Then
Set Me.ListBox = _
ListBox
End If
End If
Rebind = True
End Function
Public Function AddItems(Optional ListBox As Variant) As Boolean
Attribute AddItems.VB_Description = "Populates the ListBox with the contents of the underlying VBOFCollection"
' Populates the ListBox with one line of information
' for each object in this VBOFListBoxWrapper
' 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:
' MyVBFWListBoxWrapper.AddItems MyListBox
' (although 'MyListBox' is optional)
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
AddItems = _
pvtCollection. _
pvtListBoxAddItems _
(ListBox:=pvtListBox)
End Function
Public Function Clear(Optional ListBox As Variant, Optional FreeObjects As Variant) As Boolean
Attribute Clear.VB_Description = "Clears (empties) the ListBox and the underlying VBOFCollection"
' Empties the objects from the ListBox and removes
' the corresponding objects from the Collection
' Note: this method should be coded as follows:
' MyVBFWListBoxWrapper.Clear _
' MyListBox
' (although 'MyListBox' is optional)
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
Clear = _
pvtCollection. _
pvtListBoxClear _
(ListBox:=pvtListBox)
End Function
Public Property Get ListBox() As Variant
Attribute ListBox.VB_Description = "Sets the underlying ListBox"
Set ListBox = pvtListBox
End Property
Public Function ListCount(Optional ListBox As Variant) As Long
Attribute ListCount.VB_Description = "Returns the ListCount property of the underlying ListBox"
' Returns the ListBox's ListCount property
' Note: this method should be used as follows:
' MyListCount = _
' MyVBFWListBoxWrapper.ListCount
' (MyListBox)
' (although 'MyListBox' is optional)
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
ListCount = _
pvtCollection. _
pvtListBoxListCount _
(ListBox:=pvtListBox)
End Function
Public Property Get ListIndex() As Long
Attribute ListIndex.VB_Description = "Sets the ListIndex property of the underlying ListBox"
' Returnss the ListBox's ListIndex
' Note: this method should be used as follows:
' MyListIndex = _
' MyVBFWListBoxWrapper.ListIndex
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
ListIndex = _
pvtCollection. _
pvtListBoxListIndex _
(pvtListBox)
End Property
Public Property Let ListIndex(ListIndex As Long)
' Sets the ListBox's ListIndex
' Note: this method should be used as follows:
' MyVBFWListBoxWrapper.ListIndex = _
' MyListIndex
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
pvtCollection. _
pvtListBoxListIndex _
(pvtListBox) = _
ListIndex
End Property
Public Property Get ListIndexObject() As Variant
Attribute ListIndexObject.VB_Description = "Sets the ListIndex property of the underlying ListBox according to the object"
' Returns the object at the ListBox's ListIndex
' Note: this method should be coded as follows:
' Dim MyObject as MyObject
' Set MyObject = _
' MyVBFWListBoxWrapper.ListIndexObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set ListIndexObject = _
pvtCollection. _
pvtListBoxListIndexObject _
(pvtListBox)
End Property
Public Property Set ListIndexObject(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:
' Dim MyObject as MyObject
' MyVBFWListBoxWrapper.ListIndexObject = _
' MyObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set pvtCollection. _
pvtListBoxListIndexObject _
(pvtListBox) = _
Object
End Property
Public Function Refresh(Optional ListBox As Variant, Optional DisplayOnly As Variant) As Boolean
Attribute Refresh.VB_Description = "Refreshes the VBOFCollection and ListBox"
' Refreshes the display of the ListBox
' Note: this method should be coded as follows:
' MyVBFWListBoxWrapper.Refresh
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
Refresh = _
pvtCollection. _
pvtListBoxRefresh _
(ListBox:=pvtListBox)
End Function
Public Function RemoveItem(Optional ListBox As Variant, Optional ListIndex As Variant) As Boolean
Attribute RemoveItem.VB_Description = "Removes the Item from the ListBox and the underlying VBOFCollection"
' Removes the Object at the specified ListIndex
' from the ListBox
' Note: this method should be coded as follows:
' Dim MyUndesiredListIndex As Long
' MyVBFWListBoxWrapper.RemoveListIndex _
' ListIndex:=MyUndesiredListIndex
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
RemoveItem = _
pvtCollection. _
pvtListBoxRemoveItem( _
ListBox:=pvtListBox, _
ListIndex:=ListIndex)
End Function
Public Function RemoveObject(Optional ListBox As Variant, Optional Object As Variant) As Boolean
Attribute RemoveObject.VB_Description = "Removes the Object from the ListBox and the underlying VBOFCollection"
' Removes the specified Object from the ListBox
' Note: this method should be coded as follows:
' Dim MyUndesiredObject As MyClass
' MyVBFWListBoxWrapper.RemoveObject _
' Object:=MyUndesiredObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized _
(ListBox:=ListBox) _
Then
Exit Function
End If
RemoveObject = _
pvtCollection. _
pvtListBoxRemoveObject( _
ListBox:=pvtListBox, _
Object:=Object)
End Function
Public Property Get SelectedObjects() As Collection
Attribute SelectedObjects.VB_Description = "Returns a VB Collection containing the objects equating to the items in the ListBox which are selected"
' Returns a collection of the selected objects
' of the specified ListBox
' Note: this method should be coded as follows:
' Dim MyCollection As Collection
' Set MyCollection = _
' MyVBFWListBoxWrapper.SelectedObjects
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set SelectedObjects = _
pvtCollection. _
pvtListBoxSelectedObjects _
(pvtListBox)
End Property
Public Property Set SelectedObjects(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
' Set MyVBFWListBoxWrapper.SelectedObjects = _
' MyCollection
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set pvtCollection. _
pvtListBoxSelectedObjects _
(pvtListBox) = _
Collection
End Property
Public Property Get SelectObject() As Variant
Attribute SelectObject.VB_Description = "Returns the object which is currently selected in the ListBox"
' Returns the selected object from the ListBox
' Note: this method should be coded as follows:
' Dim MyDesiredObject As MyClass
' Set MyDesiredObject = _
' MyVBFWListBoxWrapper.SelectObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set SelectObject = _
pvtCollection. _
pvtListBoxSelectObject _
(pvtListBox)
End Property
Public Property Set SelectObject(Object As Variant)
' Selects the specified Object from the ListBox
' Note: this method should be coded as follows:
' Dim MyDesiredObject As MyClass
' Set MyVBFWListBoxWrapper.SelectObject = _
' MyDesiredObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set pvtCollection. _
pvtListBoxSelectObject _
(pvtListBox) = _
Object
End Property
Public Property Get TopIndex() As Long
Attribute TopIndex.VB_Description = "Maps to the ListBox.TopIndex property"
' Returns the ListBox's TopIndex property
' Note: this method should be used as follows:
' MyTopIndex = _
' MyVBFWListBoxWrapper.TopIndex
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
TopIndex = _
pvtCollection. _
pvtListBoxTopIndex _
(pvtListBox)
End Property
Public Property Get Text() As String
Attribute Text.VB_Description = "Retuens the Text property of the ComboBox"
' Returns the ComboBox's Text property
' Note: this method should be used as follows:
' MyString = _
' MyVBFWListBoxWrapper.Text
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Text = _
pvtCollection. _
pvtComboBoxText _
(pvtListBox)
End Property
Public Property Let Text(aString As String)
' Sets the ComboBox's Text property to aString
' Note: this method should be used as follows:
' MyVBFWListBoxWrapper.Text = _
' MyString
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
pvtCollection. _
pvtComboBoxText _
(pvtListBox) = _
aString
End Property
Public Property Let TopIndex(aLong As Long)
' Sets the ListBox's TopIndex property to aLong
' Note: this method should be used as follows:
' MyVBFWListBoxWrapper.TopIndex = _
' MyTopIndex
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
pvtCollection. _
pvtListBoxTopIndex _
(pvtListBox) = _
aLong
End Property
Public Property Get TopObject() As Variant
Attribute TopObject.VB_Description = "Maps to the object which occupies the ListBox.TopIndex property"
' Returns the Object at the ListBox's TopIndex property
' Note: this method should be used as follows:
' Set MyTopObject = _
' MyVBFWListBoxWrapper.pvtListBoxTopObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
Set TopObject = _
pvtCollection. _
pvtListBoxTopObject _
(ListBox:=pvtListBox)
End Property
Public Property Set TopObject(Object As Variant)
' Sets the ListBox's TopIndex property to the
' position of Object
' Note: this method should be used as follows:
' Set MyVBFWListBoxWrapper.TopObject = _
' MyTopObject
On Local Error Resume Next
' bullet-proofing
If Not pvtIsFullyInitialized() _
Then
Exit Property
End If
pvtCollection. _
pvtListBoxTopObject _
(pvtListBox) = _
Object
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 Property Set Collection(Collection As Variant)
Attribute Collection.VB_Description = "Sets the underlying VBOFCollection"
If Collection Is Nothing Then
Set pvtCollection = Nothing
Exit Property
End If
pvtVerifyCollection _
Collection:=Collection, _
Verbose:=True
End Property
Public Property Get Collection() As Variant
' Returns my VBOFCollection object
Set Collection = pvtCollection
End Property
Public Property Set ListBox(ListBox As Variant)
pvtVerifyListBox _
ListBox:=ListBox
End Property
Private Function pvtVerifyListBox(Optional ListBox As Variant, Optional Verbose As Variant) As Boolean
pvtVerifyListBox = _
ObjectManager. _
pvtWrapperVerifyControl( _
Control:=ListBox, _
pvtControl:=pvtListBox, _
Verbose:=Verbose)
End Function
Private Function pvtUseListBox(Optional ListBoxParm As Variant, Optional Verbose As Variant) As Variant
Set pvtUseListBox = _
ObjectManager. _
pvtWrapperUseControl( _
ControlParm:=ListBoxParm, _
pvtControl:=pvtListBox, _
SupportedNames:=pvtSupportedTypeNames, _
Verbose:=Verbose, _
WrapperName:="ListBox")
End Function
Private Function pvtErrorMessage(Optional ErrorMessage As Variant) As Long
pvtErrorMessage = _
pvtVBOFObjectManager.DisplayErrorMessage _
(ErrorMessage)
End Function
Private Function pvtIsFullyInitialized(Optional Collection As Variant, Optional ListBox As Variant, Optional Verbose As Variant) As Boolean
If Not pvtVerifyCollection( _
Collection:=Collection, _
Verbose:=Verbose) _
Then
pvtIsFullyInitialized = False
Exit Function
End If
If Not pvtVerifyListBox( _
ListBox:=ListBox, _
Verbose:=Verbose) _
Then
pvtIsFullyInitialized = False
Exit Function
End If
pvtIsFullyInitialized = True
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:="ListBox")
End Function
Private Function pvtVerifyCollection(Optional Collection As Variant, Optional Verbose As Variant) As Boolean
