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_lParent As Long
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

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Property Get m_cParent() As cParent
Dim oTemp As cParent
   
   ' Here we turn our uncounted reference
   ' (which is just a pointer to the object)
   ' into a VB usable object.
   
   ' Note that if the instance of the object
   ' pointed to by the uncounted reference had
   ' gone out of scope, m_lParent will point to
   ' random memory.  The result of calling this
   ' method in that circumstance would be undefined..
   ' probably this will be a GPF. If you are lucky,
   ' you will get "object variable not set"
   
   ' Turn the pointer into an illegal, uncounted interface
   CopyMemory oTemp, m_lParent, 4
   ' Do NOT hit the End button here! You will crash!
   ' Assign to legal reference
   Set m_cParent = oTemp
   ' Still do NOT hit the End button here! You will still crash!
   ' Destroy the illegal reference
   CopyMemory oTemp, 0&, 4
   
End Property

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)
   m_lParent = ObjPtr(cThis)
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