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