home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / COMPTOOL / ACTVCOMP / COFFEE / XTIMER.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1997-01-08  |  6.5 KB  |  186 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "XTimer"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11. '===============================================
  12. ' WARNING!  DO NOT press the End button while
  13. '   debugging this project!  See explanation
  14. '   at the top of the XTimerSupport module
  15. '   (XTimerS.bas).
  16. '===============================================
  17.  
  18. ' Private storage for XTimer properties:
  19. Private mlngTimerID As Long
  20. Private mlngInterval As Long
  21. Private mblnEnabled As Boolean
  22.  
  23. ' The XTimer's only event is Tick.  XTimer's Tick event
  24. '   doesn't have any arguments (eliminating arguments speeds
  25. '   up the event slightly), but there's no reason why you
  26. '   couldn't supply arguments if you wanted to.
  27. Event Tick()
  28.  
  29. ' TimerID property is required by the EndTimer procedure,
  30. ' ----------------   in order to quickly locate the timer
  31. '   in the support module's array of active timers.
  32. '
  33. ' There's no reason for the client to use this property,
  34. '   so it's declared Friend instead of Public.
  35. '
  36. Friend Property Get TimerID() As Long
  37.     TimerID = mlngTimerID
  38. End Property
  39.  
  40. ' Enabled property turns the timer on and off.  This is
  41. ' ----------------      done by killing the system timer,
  42. '   because there's no way to suspend a system timer.
  43. '   If they exist, they're running.
  44. '
  45. Public Property Get Enabled() As Boolean
  46.     Enabled = mblnEnabled
  47. End Property
  48. '
  49. Public Property Let Enabled(ByVal NewValue As Boolean)
  50.     ' If there's no change to the state of
  51.     '   the property, then exit.  This
  52.     '   prevents starting a second system
  53.     '   timer when one is already running,
  54.     '   etcetera.
  55.     If NewValue = mblnEnabled Then Exit Property
  56.     '
  57.     ' Save the new property setting.
  58.     mblnEnabled = NewValue
  59.     '
  60.     ' If the Interval is zero, the timer
  61.     '   is already stopped.  Don't start it.
  62.     If mlngInterval = 0 Then Exit Property
  63.     '
  64.     ' Turn timer on or off.
  65.     If mblnEnabled Then
  66.         Debug.Assert mlngTimerID = 0
  67.         mlngTimerID = BeginTimer(Me, mlngInterval)
  68.     Else
  69.         ' The following is necessary, because
  70.         '   an XTimer can shut off its system
  71.         '   timer two ways:  Enabled = False,
  72.         '   or Interval = 0.
  73.         If mlngTimerID <> 0 Then
  74.             Call EndTimer(Me)
  75.             mlngTimerID = 0
  76.         End If
  77.     End If
  78. End Property
  79.  
  80. ' Interval property must do more than just set the
  81. ' -----------------   timer interval.  If the XTimer
  82. '   is enabled, and the Interval is changed from zero
  83. '   to a non-zero value, then a system timer must be
  84. '   started.  Likewise, if the Interval is changed
  85. '   to zero, the system timer must be stopped.
  86. '
  87. ' The Property Let procedure also ends one system timer
  88. '   and starts another whenever the interval changes.
  89. '   This is because there's no way to change the
  90. '   interval of a system timer.
  91. '
  92. Public Property Get Interval() As Long
  93.     Interval = mlngInterval
  94. End Property
  95. '
  96. Public Property Let Interval(ByVal NewInterval As Long)
  97.     ' If the new value for Interval is the same as the old,
  98.     '   there's no reason to do anything.
  99.     If NewInterval = mlngInterval Then Exit Property
  100.     '
  101.     ' Save the new value.
  102.     mlngInterval = NewInterval
  103.     '
  104.     ' If the XTimer is active, mlngTimerID is non-zero.
  105.     '   in this case, the old system timer must be
  106.     '   ended before a new one is started.
  107.     If mlngTimerID <> 0 Then
  108.         Call EndTimer(Me)
  109.         mlngTimerID = 0
  110.     End If
  111.     '
  112.     ' If the new interval is zero, then the XTimer
  113.     '   becomes inactive, regardless of the current
  114.     '   value of Enabled.  If the new interval is
  115.     '   not zero, AND the Enabled property is True,
  116.     '   then a new system timer is started, and its
  117.     '   ID is stored in mlngTimerID.
  118.     If (NewInterval <> 0) And mblnEnabled Then
  119.         mlngTimerID = BeginTimer(Me, NewInterval)
  120.     End If
  121. End Property
  122.  
  123. ' RaiseTick method is called by the support module when
  124. ' ----------------   the system timer event occurs for
  125. '   this XTimer object's system timer.
  126. '
  127. ' Implementation detail:  You might expect to declare
  128. '   this method Friend instead of Public, as there's
  129. '   no need for the client to call RaiseTick.  However,
  130. '   it's critical that RaiseTick be declared Public,
  131. '   because the XTimer might be released while the
  132. '   Tick event is still being handled.  An object will
  133. '   not terminate while one of its Public methods is
  134. '   on the stack, but it CAN terminate while one of its
  135. '   Friend methods is on the stack.  If the object
  136. '   terminates before the Friend method returns (which
  137. '   could happen if the client executes a lot of code
  138. '   in the XTimer's Tick event), a GPF will result.
  139. '   (Note that this is a highly unusual scenario that
  140. '   depends on an external event; it does not occur in
  141. '   ordinary use of Friend functions.)
  142. '
  143. Public Sub RaiseTick()
  144.     RaiseEvent Tick
  145. End Sub
  146.  
  147. Private Sub Class_Terminate()
  148.     ' When the client releases its last reference to
  149.     '   an XTimer object, it goes away -- but only
  150.     '   if the XTimer's Enabled property is False,
  151.     '   or its Interval property is True!
  152.     '
  153.     ' This is because while the XTimer's system
  154.     '   timer is running, the XTimerSupport module
  155.     '   has to have a reference to the XTimer in
  156.     '   order to raise its Tick event.  Thus,
  157.     '   failure of the client to disable XTimer
  158.     '   objects before releasing them will LEAK
  159.     '   system timers!
  160.     '
  161.     ' These leaked system timers will not be
  162.     '   recovered until the XTimers component shuts
  163.     '   down -- that is, when the client using
  164.     '   the DLL shuts down.  The DLL will NOT
  165.     '   unload when all XTimer objects are released,
  166.     '   because references to public objects (in
  167.     '   this case, those held by XTimerSupport)
  168.     '   will prevent a DLL from unloading.
  169.     '
  170.     ' So why bother to clean up the system timer
  171.     '   in the Terminate event?  Because when the
  172.     '   DLL is getting shut down, all references
  173.     '   to the XTimer object will be cleaned up
  174.     '   -- and the XTimer will get its Terminate
  175.     '   event.  The system timer should be
  176.     '   destroyed at this point.
  177.     On Error Resume Next
  178.     If mlngTimerID <> 0 Then KillTimer 0, mlngTimerID
  179.     '
  180.     ' The following is what XTimer should do if
  181.     '   it could somehow be released prior to
  182.     '   DLL shutdown.
  183.     'If mlngTimerID <> 0 Then Call EndTimer(Me)
  184. End Sub
  185.  
  186.