Option Explicit
 
Private myId&, myInterval&
Private myDontWait As Boolean
Private myShouldEnable As Boolean
 
Public Event Timer()
 
'Wenn DontWait = true, dann feuert der Timer-Event schon
'sofort, wenn der Timer mit Enanbled = true gestartet
'wird
Public Property Get DontWait() As Boolean
   DontWait = myDontWait
End Property
 
Public Property Let DontWait(nVal As Boolean)
   myDontWait = nVal
End Property
 
 
'Der Timer ist aktiviert, wenn seine API-Id ungleich null ist
Public Property Get Enabled() As Boolean
   Enabled = (myId <> 0)
End Property
 
'Wenn der Timer mit Enabled = true gestartet wird,
'startet er nach jedem TimerEvent wieder von Neuem
'(solange er im Eventhandler der Timer nicht angehalten wird)
'vgl.: Function Start
Public Property Let Enabled(nVal As Boolean)
   'Den Wert für Enabled extra merken
   'falls Property Enabled im Ereignishandler
   'verändert wird (siehe: TmrCallback)
   myShouldEnable = nVal
   If nVal = True Then
      'den Timer nur Starten, wenn das Intervall grösser 0 ist
      If myInterval > 0 Then
         Start myInterval
         'wenn der Timer-Event sofort beim Starten
         'des Timers des erste Mal ausgelöst werden soll,
         'tun wir das jetzt auch
         If myId <> 0 And DontWait Then
            RaiseEvent Timer
         End If
      End If
   Else 'Timer anhalten
      If myId <> 0 Then
         Quit
      End If
   End If
 
End Property
 
'Intervall des Timers in Millisekunden
Public Property Get Interval() As Long
   Interval = myInterval
End Property
 
Public Property Let Interval(nVal&)
   myInterval = nVal
End Property
 
'Wenn der Timer vom die Klasse aufrufenden Code mit Function Start
'gestartet wird, wird der Timer-Event nur einmal abgefeuert
'und der aufrufende Code muss den Timer neu starten.
'Wenn's weitere Timer-Events geben soll, muss der Timer im aufrufenden
'Code neu gestartet werden
'vgl.: Property Get Enabled
'Start gibt die ID des API-Timers zurück
'oder 0 bei Misserfolg
Public Function Start(lngInterval&) As Long
   If myId <> 0 Then
      Start = myId
      Exit Function
   End If
   myInterval = lngInterval
 
   myId = VBStartTimer(ObjPtr(Me), lngInterval)
 
   Start = myId
End Function
 
'Hält den Timer an
Public Function Quit() As Long
   If myId <> 0 Then
      'Timer nur löschen, wenn es
      'tatsächlich auch noch einen
      'Timer gibt
      Quit = VBKillTimer(myId)
      myId = 0
   End If
End Function
 
'Diese Sub wird vod moTimer.TimerProc aufgerufen
'wenn der Timer ausgelöst wird
Friend Sub TmrCallBack()
   'Timer löschen, damit der Event erst voll
   'abgearbeitet werden kann, bevor der
   'nächste Event kommt
   Quit
   RaiseEvent Timer
   If myShouldEnable Then
      Start myInterval
   End If
 
End Sub
 
Private Sub Class_Initialize()
   myInterval = 1000
End Sub
 
Private Sub Class_Terminate()
   Quit
End Sub