EasyTimer

[cxAlex]

Danke, schön das du meinen Code brauchen kannst.
Das mit dem Delay stell ich für die nächste Version wieder um. (Die nenne ich dann mal 1.0)

> Vielleicht die Eventkennung su umbauen das man in der eigenen Thread noch den Pause und Free abfragen kann um noch wichtige verarbeitungen durchführen kann

Ich hab nicht ganz verstanden was du meinst?


Gruß, Alex

[mk-soft]

Ihr noch dein letzter Code mit der Anpassung mit Delay(...)

Code: Alles auswählen

; ; ------------------------------------------------------------------------------------
; Easy Timer
; Einfacher leicht erweiterbarer Timer
; PB 4.3 +
; Alexander Aigner
; ------------------------------------------------------------------------------------

; ------------------------------------------------------------------------------------
; Internes Zeugs
; ------------------------------------------------------------------------------------

Prototype HR_Time()

Structure _HR_Internal
  TicksPerSecond.l
  Frequency.q
  StartTime.q
EndStructure

Define _HR._HR_Internal
Global GetTimeMS.HR_Time

Procedure _HR_InitTime()
  Shared _HR._HR_Internal
  With _HR
    If Not QueryPerformanceFrequency_(@\Frequency)
      ProcedureReturn 0
    Else
      QueryPerformanceCounter_(@\StartTime)
      \TicksPerSecond = 1000 ; 1000 = Millisekunden
      ProcedureReturn 1
    EndIf
  EndWith
EndProcedure

Procedure _HR_Get()
  Shared _HR._HR_Internal
  Protected currentTime.q
  With _HR
    QueryPerformanceCounter_(@currentTime)
    ProcedureReturn (currentTime-\StartTime)*\TicksPerSecond/\Frequency
  EndWith
EndProcedure

Procedure _HR_oldPC_or_Linux()
  ProcedureReturn ElapsedMilliseconds()
EndProcedure

CompilerIf #PB_Compiler_OS<>#PB_OS_Windows
  GetTimeMS = @_HR_oldPC_or_Linux()
CompilerElse
  If _HR_InitTime()
    GetTimeMS = @_HR_Get()
  Else
    GetTimeMS = @_HR_oldPC_or_Linux()
  EndIf
CompilerEndIf

Prototype ET_Procedure(UserData)

Structure ET_Data
  *CB.ET_Procedure
  UserData.i
  Delay.i
  CBEventStop.i
  CBEventPause.i
EndStructure

Procedure _ET_Thread(*ET.ET_Data)
  Protected dTime, cTime, wTime
  With *ET
    Repeat
     
      wTime = \Delay - dTime
      cTime = GetTimeMS()
      If wTime > 50
        Delay(wtime)
      Else
        While wTime > GetTimeMS()-cTime
          Delay(1)
        Wend
      EndIf
      
      If \CBEventPause ; Pausesignal
        WaitSemaphore(\CBEventPause)
      EndIf
      If \CBEventStop ; Stopsignal
        SignalSemaphore(\CBEventStop)
        ProcedureReturn #Null
      EndIf
     
      ; Callback aufrufen und Ausgelichszeit errechnen
      cTime = GetTimeMS()
      \CB(\UserData)
      dTime = GetTimeMS()-cTime
     
      ; Delay(<0) = warte unendlich
      If dTime<0
        dTime = 0
      ElseIf dTime>\Delay
        dTime = \Delay
      EndIf
     
    ForEver
  EndWith
EndProcedure

; ------------------------------------------------------------------------------------
; Proceduren
; ------------------------------------------------------------------------------------

; Neuen Timer anlegen
Procedure ET_New(*Callback.ET_Procedure, Delay.i, UserData.i)
  Protected *ET.ET_Data = AllocateMemory(SizeOf(ET_Data))
  With *ET
    \CB = *Callback
    \Delay = Delay
    \UserData = UserData
    CreateThread(@_ET_Thread(), *ET)
    ProcedureReturn *ET
  EndWith
EndProcedure

; Timer pausieren
Procedure ET_Pause(*ET.ET_Data)
  With *ET
    If Not \CBEventPause
      \CBEventPause = CreateSemaphore()
    EndIf
  EndWith
EndProcedure

; Timer fortsetzen
Procedure ET_Resume(*ET.ET_Data)
  With *ET
    If \CBEventPause
      SignalSemaphore(\CBEventPause)
      FreeSemaphore(\CBEventPause)
    EndIf
  EndWith
EndProcedure

; Timer freigeben
Procedure ET_Free(*ET.ET_Data)
  With *ET
    \CBEventStop = CreateSemaphore()
    ET_Resume(*ET) ; Wenn nötig fortsetzen
    WaitSemaphore(\CBEventStop)
    FreeSemaphore(\CBEventStop)
    FreeMemory(*ET)
  EndWith
EndProcedure

; ------------------------------------------------------------------------------------
; Test
; ------------------------------------------------------------------------------------

Procedure Test(Dummy)
  Static x, lT, cT
  cT = GetTimeMs()
  If lT
    Debug "Getriggert nach " + Str(cT-lT)+" ms"
  Else
    Debug "Timer Initialisiert"
  EndIf
  lT = ct
  x +1
  ;Debug x
EndProcedure

; Test alle 100 ms aufrufen

Timer1 = ET_New(@Test(), 45, #Null)
Delay(1010)
; Timer freigeben
ET_Free(Timer1)

Mit den Event meine ich das der Callback noch einmal aufgerufen wird mit der Info das ein Pause, Resume oder eine Free ansteht.

P.S. Die Callback Procdure mit ein weiteren Parameter versorgen
z.B. Test(Event, UserData)

[cxAlex]

Achso. Kein Problem, ist machbar.

[cxAlex]

Update:

• Delay wieder umgebaut
• Events eingeführt
• Versionsnummer eingeführt: 1.0

Code im 1. Post.

Gruß, Alex

[mk-soft]

[cxAlex]

Update:

Pausieren/Beenden funktionieren nun unabhängig vom Timer-Delay.

Code im 1. Post

Gruß, Alex

[Andesdaf]

Dankeschön.

[hiltwin]

Sorry, dass ich diesen älteren Thread noch mal an die Oberfläche befördere.

Der Timer gefällt mir ja prima. Allerdings funktioniert die Systrayfunktion nicht komplett.

Auf dem kompilierenden Rechner wird das Programm korrekt mit Icon dargestellt, auf anderen PCs allerdings nicht. Beide PC haben Windows XP Home SP 3 - also identische Betriebssysteme.

Jemand eine Idee, woran das liegt?

Diese Variante - der Code von mk-soft - funktioniert auf mehreren Rechnern ...

http://forums.purebasic.com/german/view ... =16&t=9577

[c4s]

Sorry, dass ich diesen älteren Thread noch mal an die Oberfläche befördere.

Der Timer gefällt mir ja prima. Allerdings funktioniert die Systrayfunktion nicht komplett.

Auf dem kompilierenden Rechner wird das Programm korrekt mit Icon dargestellt, auf anderen PCs allerdings nicht. Beide PC haben Windows XP Home SP 3 - also identische Betriebssysteme.

Jemand eine Idee, woran das liegt?

Diese Variante - der Code von mk-soft - funktioniert auf mehreren Rechnern ...

http://forums.purebasic.com/german/view ... =16&t=9577

Worauf beziehst du dich?
Der Code von cxAlex (erster Post) hat keine SysTray-Funktion. Sonst einfach mal in der Hilfe den SysTray-Bereich nachschlagen...

[hiltwin]

Worauf beziehst du dich?
Der Code von cxAlex (erster Post) hat keine SysTray-Funktion. Sonst einfach mal in der Hilfe den SysTray-Bereich nachschlagen...

Mist - Sonntag morgen

cxAlex hat den fast identischen Code auch noch mal hier gepostet - inclusive SysTray - mit der oben beschriebenen Fehlfunktion ...

http://forums.purebasic.com/german/view ... 2e13855e06