vbAccelerator - Contents of code file: cWorker.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cWorker"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' Store reference to parent as an
' uncounted reference:
Private m_cParent As cParent
Private m_lIterations As Long
Private m_lInitValue As Long
Private m_lValue
Private m_sKey As String

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Friend Property Let Key(ByVal sKey As String)
   m_sKey = sKey
End Property
Friend Property Get Key() As String
   Key = m_sKey
End Property

Friend Sub Init(ByRef cThis As cParent)
   
   ' Store a copy of the parent:
   Set m_cParent = cThis
   
   ' This child object is forced to terminate when the
   ' parent terminates.  Therefore we can remove the
   ' reference count to the parent we've just added.
   Dim iU As IShellFolderEx_TLB.IUnknown
   Set iU = m_cParent
   iU.Release
   
   ' Erm, but there is a problem.  This is that if this class
   ' terminates prior to the parent class, then VB
   ' will try and call Release on the Parent too
   ' many times.  Since the memory associated with
   ' Parent will be cleared once Parent's reference
   ' count has got to zero, this will cause a GPF.
   ' So therefore if you were to use this method
   ' you have to be certain that the m_cParent will
   ' terminate first.
   
End Sub
Public Property Let Iterations(ByVal lIter As Long)
   m_lIterations = lIter
End Property
Public Property Let InitialValue(ByVal lValue As Long)
   m_lInitValue = lValue
End Property
Public Property Get Value() As Long
   Value = m_lValue
End Property
Public Sub DoProcess()
Dim i As Long
Dim j As Long
Dim lT As Long
   ' Here we would actually run some
   ' algorithm...
   For i = 1 To m_lIterations
      For j = 1 To 5
         lT = timeGetTime
         Do While timeGetTime - lT < 1
            
         Loop
      Next j
      m_cParent.Progress Me, j
   Next i
   m_cParent.Complete Me
   
End Sub

Private Sub Class_Initialize()
   MsgBox "cWorker:Initialize"
End Sub

Private Sub Class_Terminate()
   MsgBox "cWorker:" & m_sKey & ":Terminate"
End Sub