DelayedEventHandler.cls #1

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DelayedEventHandler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' DelayedEvent Handler class

' Basically has a collection of events waiting to be processed and a single
' timer.
' When the timer fires it tries to process all of the events in the queue in order

Private m_DelayedEvents As Collection
Private WithEvents m_Timer As CTimer
Attribute m_Timer.VB_VarHelpID = -1

Const cTimeInterval = 10    ' milliseconds

Public Sub Add(de As DelayedEvent)

    Init
    ' Now add new event
    m_DelayedEvents.Add de

End Sub

Private Sub Init()

    If m_Timer Is Nothing Then
        Set m_Timer = New CTimer
    End If
    If m_DelayedEvents Is Nothing Then
        Set m_DelayedEvents = New Collection
    End If

    m_Timer.Interval = cTimeInterval

End Sub

' This fires when timer goes off
Private Sub m_Timer_ThatTime()
    On Error GoTo Error_Block
    Dim T As Tracker: Set T = GStackTrace.Enter(TypeName(Me), "m_Timer_ThatTime")
    Dim de As DelayedEvent

    m_Timer.Interval = 0        ' Turn ourselves off - only want to fire once
    If m_DelayedEvents.Count <> 0 Then
        ' Action first event and then delete it
        Set de = m_DelayedEvents(1)
        de.DoEvent
        m_DelayedEvents.Remove 1
        ' If necessary, reset timer to process next event
        If m_DelayedEvents.Count <> 0 Then
            m_Timer.Interval = cTimeInterval
        End If
    End If
    
    Exit Sub

Error_Block:
    If err.Description <> "Method '~' of object '~' failed" Then
        T.Report
    End If
End Sub