Collection Class Basics

To demonstrate the basic concepts and techniques used to create a class module, this section is devoted to creating a small class I recently used on an Access database application. The specifications required that the user interface take on the look and feel of an existing Web application. One of the features of this application was its navigation, which had to mimic the Back and Forward buttons found in Internet Explorer.

To implement this behavior, we could have created a string array that contained the names of each form visited, and simply increment or decrement a counter to move from form to form. Instead, we opted to create a collection class called clsDogs.

We have modified the following example class to make use of our clsDog class, as that's what we'll be storing in the collection. Take a while to look it over in order to understand how it works.

The Collection object is declared at module level and instantiated in the Initialize event. Following best practice, the Terminate event destroys the Collection instance and any objects it may still contain. The On Error statement in the Terminate event really isn't necessary, but I always add it just in case.

Option Compare Database Option Explicit

Private col As Collection 'Declare the collection object

Private Sub Class_Initialize()

'Instantiates the collection object. Set col = New Collection End Sub

Private Sub Class_Terminate()

'Destroys the collection object. On Error Resume Next Set col = Nothing End Sub

The Push method adds a pointer to the new Dog object (already instantiated in the test code) to the collection, using the unique Key passed as one of the method's parameters. If an optional Before or After parameter is included in the call, the Push method inserts the object before or after the object that occupies the position specified by the varBefore or varAfter parameter.

Public Sub Push(objMember As clsDog, strKey As String, _

Optional varBefore As Variant, Optional varAfter As Variant)

'Adds a member to the collection.

On Error Resume Next

If Not IsMissing(varBefore) Then

Col.Add objMember, strKey,

varBefore

ElseIf Not IsMissing(varAfter)

Then

Col.Add objMember, strKey,

, varAfter

Else

col.Add objMember, strKey

End If

If Err.Number <> 0 Then

ThrowError Err.Number, Err.

.Description, Err.Source

End If

End Sub

The following procedure removes the member specified by strKey from the collection, but does not return anything to the calling code:

Public Sub Remove(strKey As Variant)

'Removes a member from the collection. On Error Resume Next col.Remove strKey

ThrowError Err.Number, Err.Description, Err.Source End If End Sub

The FirstMember property returns a pointer to the object that occupies the first position in the collection, but it doesn't remove it from the collection as do the two Pop methods. You can see that position 1 is specified in the object assignment statement:

Set FirstMember = col(1)

Public Property Get FirstMember() As clsDog

'Returns the first member added to the collection, 'but does NOT remove it from the collection.

On Error Resume Next

'Get the first member. Set FirstMember = col(1)

ThrowError Err.Number, Err.Description, Err.Source End If End Property

Similarly, the LastMember property returns a pointer to the object that occupies the last position in the collection.

Public Property Get LastMember() As clsDog

'Returns the last member added to the collection, 'but does NOT remove it from the collection.

On Error Resume Next

'Get the last member.

Set LastMember = col(col.Count)

ThrowError Err.Number, Err.Description, Err.Source End If End Property

The Pop method returns a pointer to the object that occupies the last position in the collection, and then removes it from the collection, thus destroying it.

Public Function Pop() As clsDog

'Pops the last member added to the collection, 'and removes it from the collection. Dim objMember As clsDog

On Error Resume Next

'Pops the last member.

Set objMember = col(col.Count)

col.Remove col.Count

ThrowError Err.Number, Err.Description, Err.Source

Else

Set Pop = objMember End If

Set objMember = Nothing End Function

The PopFirstMember method returns a pointer to the object that occupies the first position in the collection, and then removes the object from the collection, destroying it.

Public Function PopFirstMember() As clsDog

'Pops the first member added to the collection, 'and removes it from the collection. Dim objMember As clsDog

On Error Resume Next

'Pop the first member Set objMember = col(1) col.Remove 1

ThrowError Err.Number, Err.Description, Err.Source

Else

Set PopFirstMember = objMember End If

Set objMember = Nothing End Function

The Item property is interesting and I will shortly explain why, but for the moment the explanation is that it returns a pointer to the object whose Key matches that supplied by the strKey parameter.

Public Property Get Item(strKey As String) As clsDog

Set Item = col(strKey) End Property

The following procedure simply returns a number that represents the number of objects contained in the collection:

Public Property Get Count()

As Integer

'Returns the collection

count.

Count = col.Count

End Property

The Clear method destroys the collection and thus all objects it contains, and then reinstantiates the collection. Although I could have iterated through the collection, removing and destroying objects as I went, destroying the Collection object is faster.

Public Sub Clear()

'Clears the collection and destroys all its objects. 'This is the fastest way. Set col = Nothing Set col = New Collection End Sub

Finally, the ThrowError method takes all the errors that occur within the class and packages them up before passing them back up the error chain to the calling procedure.

Private Sub ThrowError(intError As Integer, strDescr As String, strSource As String)

'Procedure used to return errors Dim strMsg As String

Select Case intError

Case 5

strMsg =

"Member not found."

Case 9

strMsg =

"Subscript out of range."

Case 457

strMsg =

"Duplicate member."

Case Else

strMsg =

"Error " & intError & vbCrLf

& strDescr

End

Select

Err.

.Raise vbObjectError + intError, strSource,

strMsg

End Sub

Setting Unique Object Keys

Before you get too carried away with testing the above class, the Collection object demands that each Key value be unique, so that's what we'll do now. Setting unique Collection object keys is not always easy. You can't easily use incrementing numbers, because the Key parameter requires a string data type, and once you set it, it can't be changed without removing the object and reinserting it.

The best method is to use a property of the object being added (if it has one), but that isn't hard to implement. Although we didn't show you the Dog class's implementation, the following is what we used during testing. Create a new class called clsDog, and copy the following code into its module:

Private lngID As Long

Private Sub Class_Initialize()

'Generate the unique key for this object. lngID = CLng(Rnd * (2 A 31)) End Sub

Public Property Get ID() As Long

'Return the object's unique key. ID = lngID End Property

This calculation in the class's Initialize event returns a random number between 215 and 2,147,483,433. This is the largest number that will fit into a Long Integer data type, and offers sufficient range to minimize the risk of duplicates.

You can use whatever means you like to generate a key, but whichever method you choose, ensure the Key is unique in the collection.

Testing the Dogs Class

To test the functionality of the Dogs class, you can run the following code in a standard module. This test code adds four Dog objects to the Dogs object (the Collection class), and then starts removing them using three different methods: PopFirstMember, Pop, and Remove, all the while accessing the Dog object's ID property through the collection object. The first Debug.Print statement shows how to access the Dog object's ID property through the Dogs Collection class instance.

Option Compare Database Option Explicit

Public Sub TestCollectionClass() Dim DOGS As clsDogs Dim obj As clsDog Dim strKey1 As String Dim strKey As String

On Error Resume Next

Set DOGS = New clsDogs

Now add code to add a dog to the collection using the Push method.

' Add a dog to the collection Set obj = New clsDog DOGS.Push obj, CStr(obj.ID) strKey1 = obj.id Set obj = Nothing

Do the same thing three more times, to add another three dogs.

' Add another dog to the

collection

Set obj = New clsDog

DOGS.Push obj, CStr(obj.

ID)

Set obj = Nothing

' And another one...

Set obj = New clsDog

DOGS.Push obj, CStr(obj.

ID)

strKey = CStr(obj.id)

Set obj = Nothing

' And the final dog

Set obj = New clsDog

DOGS.Push obj, CStr(obj.

ID)

Set obj = Nothing

Now print the ID of the dog that occupies the first position in the collection.

Debug.Print "The first collection Member ID = " & _ DOGS.Item(strKey1).ID

Let's now start removing dogs from the collection. Firstly, let's use the PopFirst method.

'Start removing objects from the collection Debug.Print "There are now " & DOGS.Count & " members." Debug.Print "Just popped Dog " & DOGS.PopFirstMember.ID Debug.Print "There are now " & DOGS.Count & " members." Debug.Print "Just popped Dog " & DOGS.Pop.ID Debug.Print "There are now " & DOGS.Count & " members."

Now we'll take advantage of the fact that we issued the On Error Resume Next line to trap an error. 'Create an error

DOGS.Remove strKey & "some text"

If Err <> 0 Then Debug.Print "***ERROR " & Err.Number Now, let's remove the remaining dogs from the collection, without causing any errors.

Now we'll take advantage of the fact that we issued the On Error Resume Next line to trap an error. 'Create an error

DOGS.Remove strKey & "some text"

If Err <> 0 Then Debug.Print "***ERROR " & Err.Number Now, let's remove the remaining dogs from the collection, without causing any errors.

'Now do it properly

DOGS.Remove

strKey

Debug

.Print

"Just removed Dog '

' & strKey

Debug

.Print

"There are now " &

DOGS.Count

& '

members."

Debug

.Print

'Just popped Dog '

& DOGS.Pop.

ID

Debug

.Print

'There are now ' &

DOGS.Count

& '

members."

Debug

.Print

"End test"

Set DOGS = Nothing

End Sub

Specifying the Default Procedure

There are two major drawbacks to using custom Collection classes: one of them is that Access treats them as normal objects rather than true collections. As such, you do not have access to a default property or procedure. For example, using VBA, the following two statements are equivalent (to test it, ensure you have at least one form open):

Debug.Print Forms.Item(0).Name Debug.Print Forms(0).Name

The default property of the Forms collection is the Item property, which means if you want to, you can omit the Item keyword.

Using a custom Collection class, you are forced to explicitly use the Item property, as we did in our example above. But all is not lost. There is a way to tell Access which procedure to use as the default, but, of course, things are never straightforward.

You have to export the procedure to a file, manually add a line of code to the procedure definition, and then import it back into Access. The procedure for doing so is as follows:

1. From the Project Explorer window in code view, right-click the module and select Remove from the context menu.

2. When asked if you want to export the module before removing it, click Yes. The Export File dialog box is displayed.

3. Browse to a convenient folder and rename it to modulename.txt, where modulename is the name of the module you're exporting.

4. Click Save. The class is removed from the Project Explorer and saved to disk as a text file.

5. Using Windows Explorer, browse to the appropriate folder and double-click the text file to open it in Notepad.

6. Locate the procedure in question (in this case the Item property), and add a single line of text like the one we've highlighted.

Public Property Get Item(strKey As String) As clsSpoke

Attribute Item.VB_UserMemId = 0

Set Item = col(strKey)

End Property

7. Ensure that the procedure or property name appears in the attribute statement and that the attribute is set to zero.

8. Save the file and exit Notepad.

9. Back in Access code view, right-click anywhere in the Project Explorer and select Import File from the context menu. The Import File dialog box is displayed.

10. Browse to the appropriate folder, select the file you just edited, and click Open. The class is added to the Project Explorer.

You can check the Object Browser to see that a small blue ball is shown above the procedure's icon, indicating that it is now the default procedure (see Figure 12-21).

'm- Object Browser

H-lnlx!

jffl^AII LN)ranes>

<

jJ

II M & »

[classes

I Members of 'cIsDogs1

Application

A

■s CkissJnrtUilize

Auto Correct

CkissTeri nil kite

¿P BookmarkEnurn

J

a Clear

Si BoundCbjectFrame

col

251 Caialog

itf? Count

CheckBoxi

|ii§ Fh stMeinher

cIsDog

tU Item |

¿äJicIsDoys

El? LiistMemhei

<£} cIsGiite

■s NewEnum

t3 cIsKeiniel

U» Pop

Public Property Item As Long read-only

Default member of Access Book.clsDofis

Public Property Item As Long read-only

Default member of Access Book.clsDofis

Figure 12-21

While our test code previously accessed the Dog object's ID through the Dogs object like this:

DOGS.Item(strKey1).ID it can now be accessed like this: DOGS(strKey1).ID

Enumerating Collection Classes

A second drawback to using custom Collection objects is that you can't enumerate through its members. For example, consider the following code:

Public Sub TestEnumeration() Dim tdf As TableDef

For Each tdf In CurrentDb.TableDefs

Debug.Print tdf.Name Next tdf End Sub

This code allows us to enumerate, or iterate through the collection by declaring an enumeration type. To accomplish the same thing with our custom Collection class, we need to go back to Notepad as we did to specify the default procedure; only this time, we'll add an entire public procedure.

Export the class as before and open it in Notepad.

Now add the procedure exactly as it is shown below. The only change you can make is the name of the Collection object you're using (in this case, col).

Public Function NewEnum() As IUnknown Attribute NewEnum.VB_UserMemId = -4

Set NewEnum = col.[_NewEnum] End Function

Save the file and reimport it into Access as you did before.

Now you can enumerate the collection objects as you can with other Access collections.

Dim mbr As Object 'or clsSpoke For Each mbr In STACK

Debug.Print mbr.ID Next mbr

0 0

Post a comment