Private maicnClients() As iCoffeeNotify

Private mlngMaxClients As Long

' mXTimer holds a reference to a code-only timer that tells CoffeeMonitor2 when to check the pot. Because the variable is declared WithEvents, the CoffeeMonitor2 object receives the XTimer object's Tick events (see Sub mwXTimer_Tick, below). Code for the XTimer object can be found in XTimers.vbp.

Private WithEvents mwXTimer As XTimer

Private Sub Class_Initialize()

' Allocate some space in the array of client objects.

mlngMaxClients = ICN_ARRAYINCREMENT

ReDim maicnClients(1 To mlngMaxClients)

'

' Create the XTimer object. When this assignment is made, Visual Basic connects the XTimer's Tick event to the mwXTimer_Tick event procedure (see below).

Set mwXTimer = New XTimer

'

' The timer is set to tick every ten seconds (10,000 milliseconds).

mwXTimer.Interval = 10000

mwXTimer.Enabled = True

End Sub

Private Sub Class_Terminate()

Dim intCt As Integer

' It's important to disable the XTimer before releasing it. As described in XTimers.vbp, abandoning a running XTimer essentially leaks a system timer until XTimers.DLL finally shuts down.

mwXTimer.Enabled = False

Set mwXTimer = Nothing

' Release all remaining call-back clients, in case they released CoffeeMonitor2 without first requesting an end to notifications.

For intCt = 1 To mlngMaxClients

Set maicnClients(intCt) = Nothing

Next

'

Debug.Print "CoffeeMonitor2 (call-backs) terminated at " & Now

End Sub

' TellMeReady is called by a client who wants to receive a call-back when the coffee is ready. The client must implement the ICoffeeNotify interface, defined in the ICoffeeNotify class.

'

Public Sub TellMeReady(ByVal icn As iCoffeeNotify)

Dim lngCt As Long

' Find an opening in the array of interfaces.

For lngCt = 1 To mlngMaxClients

If maicnClients(lngCt) Is Nothing Then Exit For

Next

'

' If there were no openings, grow the array.

If lngCt > mlngMaxClients Then

mlngMaxClients = mlngMaxClients + ICN_ARRAYINCREMENT

ReDim Preserve maicnClients(1 To mlngMaxClients)

End If

'

Set maicnClients(lngCt) = icn

'

' Give the object the index of its entry, as a key for quick lookup when disconnection is requested.

icn.NotifyID = lngCt

End Sub

' CeaseCallBacks removes the client from the list of objects

' -------------- receiving call-back notifications, using

' the key the object was assigned when it requested

' notifications.

'

Public Sub CeaseCallBacks(ByVal icn As iCoffeeNotify)

Set maicnClients(icn.NotifyID) = Nothing

End Sub

' mwXTimer_Tick is the event procedure CoffeeMonitor2 uses to receive the XTimer object's Tick events. The name of an event procedure that's

' associated with a WithEvents variable always has the variable name as a prefix.

Private Sub mwXTimer_Tick()

Dim lngCt As Long

' (Code to test serial port omitted.)

'

On Error Resume Next

'

' The call-back method must be called for each object

' that has requested a notification.

For lngCt = 1 To mlngMaxClients

If Not maicnClients(lngCt) Is Nothing Then

maicnClients(lngCt).CoffeeReady

If Err.Number <> 0 Then

' Error &H80010005 is ignored, because it

' can be caused by the client object being

' temporarily unresponsive.

If Err.Number <> &H80010005 Then

' If a client application has closed without

' ending the notifications, remove it from

' the list.

Set maicnClients(lngCt) = Nothing

End If

'

' When On Error Resume Next is used, the

' error number must be cleared after each

' error.

Err.Number = 0

End If

End If

Next

End Sub