home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / A_Complete2049172212007.psc / CLiteTimer.cls < prev    next >
Text File  |  2006-10-31  |  4KB  |  122 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CLiteTimer"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. Private mlngInterval As Long ' The timer interval.
  19. Private mlngTimerID As Long
  20.  
  21. Dim tmrTag As String
  22.  
  23. Public Event Timer()
  24.  
  25. Public Property Let Tag(ByVal strTag As String)
  26.     On Error Resume Next
  27.     tmrTag = strTag
  28. End Property
  29.  
  30. Public Property Get Tag() As String
  31.     On Error Resume Next
  32.     Tag = tmrTag
  33. End Property
  34.  
  35. Public Property Let Enabled(ByVal blnEnabled As Boolean)
  36.     On Error GoTo ErrorHandler
  37.     ' Is the timer being started?
  38.     If blnEnabled Then
  39.         ' Is the timer currently running?
  40.         If Not MLiteTimer.TimerRunning(mlngTimerID) Then
  41.             ' Start the timer.
  42.             mlngTimerID = MLiteTimer.StartTimer(Me, mlngInterval, mlngTimerID)
  43.         End If
  44.     Else
  45.         ' Stop the timer.
  46.         MLiteTimer.StopTimer mlngTimerID
  47.     End If
  48.     Exit Property
  49. ErrorHandler:
  50.     'Debug.Print "Enabled Let Error " & Err.Number & ": " & Err.Description
  51. End Property
  52.  
  53. Public Property Get Enabled() As Boolean
  54.     On Error GoTo ErrorHandler
  55.     Enabled = MLiteTimer.TimerRunning(mlngTimerID)
  56.     Exit Property
  57. ErrorHandler:
  58.     'Debug.Print "Enabled Get Error " & Err.Number & ": " & Err.Description
  59. End Property
  60.  
  61. Public Property Let Interval(ByVal lngInterval As Long)
  62.     On Error GoTo ErrorHandler
  63.     ' Check the interval value.
  64.     If lngInterval > 0 Then
  65.         ' Check to see if the timer is currently running.
  66.         If MLiteTimer.TimerRunning(mlngTimerID) Then
  67.             ' Stop the timer.
  68.             MLiteTimer.StopTimer mlngTimerID
  69.             ' Restart the timer with the new interval.
  70.             mlngTimerID = MLiteTimer.StartTimer(Me, lngInterval, mlngTimerID)
  71.         End If
  72.         ' Store the new interval value.
  73.         mlngInterval = lngInterval
  74.     Else
  75.         mlngInterval = 0
  76.         ' Stop the timer.
  77.         MLiteTimer.StopTimer mlngTimerID
  78.     End If
  79.     Exit Property
  80. ErrorHandler:
  81.     'Debug.Print "Interval Let Error " & Err.Number & ": " & Err.Description
  82. End Property
  83.  
  84. Public Property Get Interval() As Long
  85.     On Error GoTo ErrorHandler
  86.     Interval = mlngInterval
  87.     Exit Property
  88. ErrorHandler:
  89.     'Debug.Print "Interval Get Error " & Err.Number & ": " & Err.Description
  90. End Property
  91.  
  92. Friend Sub TimerCallBack(ByVal lngTimerID As Long)
  93.     On Error GoTo ErrorHandler
  94.     ' Raise the event if the timer id's match.
  95.     If mlngTimerID = lngTimerID Then
  96.         RaiseEvent Timer
  97.     End If
  98.     Exit Sub
  99. ErrorHandler:
  100.     'Debug.Print "TimerCallBack Error " & Err.Number & ": " & Err.Description
  101. End Sub
  102.  
  103. Private Sub Class_Initialize()
  104.     On Error GoTo ErrorHandler
  105.     'Debug.Print "Creating Timer Object"
  106.     ' Set a default timer interval.
  107.     mlngInterval = 1000
  108.     Exit Sub
  109. ErrorHandler:
  110.     'Debug.Print "Class_Initialize Error " & Err.Number & ": " & Err.Description
  111. End Sub
  112.  
  113. Private Sub Class_Terminate()
  114.     On Error GoTo ErrorHandler
  115.     'Debug.Print "Destroying Timer Object"
  116.     ' Stop the timer if it is running.
  117.     MLiteTimer.StopTimer mlngTimerID
  118.     Exit Sub
  119. ErrorHandler:
  120.     'Debug.Print "Class_Terminate Error " & Err.Number & ": " & Err.Description
  121. End Sub
  122.