Konkret kann man damit eine Procedure alle x - Millisekunden im Hintergrund aufrufen lassen.
Code: Alles auswählen
; ------------------------------------------------------------------------------------
; Easy Timer
; Einfacher leicht erweiterbarer Timer
; PB 4.3 +
; Alexander Aigner
; V 1.0
; ------------------------------------------------------------------------------------
; ------------------------------------------------------------------------------------
; Internes Zeugs
; ------------------------------------------------------------------------------------
; ------------------------------------------------------------------------------------
; HighRes - Timer
; ------------------------------------------------------------------------------------
EnableExplicit
Prototype HR_Time()
Structure _HR_Internal
StartTime.q
Res.d
EndStructure
Define _HR._HR_Internal
Global GetTimeMS.HR_Time
Procedure _HR_InitTime()
Shared _HR._HR_Internal
Protected Frequency.q
With _HR
If Not QueryPerformanceFrequency_(@Frequency)
ProcedureReturn #False
Else
QueryPerformanceCounter_(@\StartTime)
\Res = 1000/Frequency
ProcedureReturn #True
EndIf
EndWith
EndProcedure
Procedure _HR_Get()
Shared _HR._HR_Internal
Protected currentTime.q
With _HR
QueryPerformanceCounter_(@currentTime)
ProcedureReturn (currentTime-\StartTime)*\Res
EndWith
EndProcedure
Procedure _HR_oldPC_or_Linux()
ProcedureReturn ElapsedMilliseconds()
EndProcedure
; Initialisierung des High-Res Timers
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
; ------------------------------------------------------------------------------------
; Eigentlicher Timer
; ------------------------------------------------------------------------------------
Prototype ET_Procedure(Event, UserData)
Enumeration ; Sollte klar sein ...
#ET_Call
#ET_Pause
#ET_Resume
#ET_Free
EndEnumeration
Structure ET_Data
*CB.ET_Procedure
UserData.i
Delay.i
CBEvent.i
CBEventStop.i
CBEventPause.i
EndStructure
Procedure _ET_Thread(*ET.ET_Data)
Protected cTime, wTime
With *ET
wTime = \Delay
Repeat
If \CBEvent ; Nur 1. If-Abfrage für (später) beliebie viele Events
If \CBEventPause ; Pausesignal
\CB(#ET_Pause, \UserData)
WaitSemaphore(\CBEventPause)
\CB(#ET_Resume, \UserData)
EndIf
If \CBEventStop ; Stopsignal
\CB(#ET_Free, \UserData)
SignalSemaphore(\CBEventStop)
ProcedureReturn #Null
EndIf
\CBEvent = #False
EndIf
cTime = GetTimeMS()
While wTime>GetTimeMS()-cTime
Delay(1)
If \CBEvent ; Nur 1. If-Abfrage für (später) beliebie viele Events
If \CBEventPause ; Pausesignal
\CB(#ET_Pause, \UserData)
WaitSemaphore(\CBEventPause)
\CB(#ET_Resume, \UserData)
EndIf
If \CBEventStop ; Stopsignal
\CB(#ET_Free, \UserData)
SignalSemaphore(\CBEventStop)
ProcedureReturn #Null
EndIf
\CBEvent = #False
EndIf
Wend
; Callback aufrufen und Ausgleichszeit errechnen
cTime = GetTimeMS()
\CB(#ET_Call, \UserData)
wTime = \Delay-GetTimeMS() + cTime
; Delay(<0) = warte unendlich
If wTime<0
wTime = #Null
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()
\CBEvent = #True
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()
\CBEvent = #True
ET_Resume(*ET) ; Wenn nötig fortsetzen
WaitSemaphore(\CBEventStop)
FreeSemaphore(\CBEventStop)
FreeMemory(*ET)
EndWith
EndProcedure
DisableExplicit
; ------------------------------------------------------------------------------------
; Test
; ------------------------------------------------------------------------------------
Procedure Test(Event, Dummy)
Static x, lT, cT
If Event = #ET_Call
x + 1
cT = GetTimeMs()
If lT
PrintN("Getriggert nach " + Str(cT-lT) + " ms " + Str(x))
Else
PrintN("Timer Initialisiert " + Str(x))
EndIf
Delay(Random(50))
lT = ct
ElseIf Event = #ET_Free
PrintN("Timer freigegeben ")
EndIf
;Debug x
EndProcedure
; Test alle 100 ms aufrufen
OpenConsole()
Timer1 = ET_New(@Test(), 50, #Null)
Delay(1020)
; Timer freigeben
ET_Free(Timer1)
Input()
CloseConsole()
).
