Chronometer - Temporizer V1.0.3 - Updated to V2.0.0
Posted: Mon Jan 02, 2006 5:17 am
A very simple Chronometer - Temporizer
it's a Based Object Programming (BOP) exemple.
Sorry all comment and Message are in French.
Regards
Guimauve
Update V1.0.3
I have added some command.
Also the exemple is a demonstration of a self-correcting temporized procedure.
The Mask$ for the command FormatMilliseconds(Masque$, MilliSeconds) is similar to FormatDate() PB Command. To ajust milliseconds use %mss to see 0.000 seconds and %ms to see 0.00 seconds.
it's a Based Object Programming (BOP) exemple.
Sorry all comment and Message are in French.
Regards
Guimauve
Update V1.0.3
I have added some command.
Also the exemple is a demonstration of a self-correcting temporized procedure.
The Mask$ for the command FormatMilliseconds(Masque$, MilliSeconds) is similar to FormatDate() PB Command. To ajust milliseconds use %mss to see 0.000 seconds and %ms to see 0.00 seconds.
Code: Select all
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Nom du projet : Exemple - Chronomètre - Temporisateur
; Fichier : Code de démonstration
; Version : 1.0.3
; Programmation = OK
; Programmé par : Guimauve
; Date : 31-12-2005
; Mise à jour : 03-01-2006
; Codé avec PureBasic V3.94
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration de la Structure >>>>>
Structure Chronometer
StartTime.l
TotalTime.l
Running.b
EndStructure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Description :
;
; Cette librairie permet de créer des Chronomètres
; et des Temporisateurs de haute précision.
;
; Temps maximal de mémorisation : capacité d'un
; entier (long) de 4 octets ou 32 bits
;
; soit 2 147 483 647 millisecondes
; ou soit environ 2 147 483 secondes
; ou soit environ 35 791 minutes
; ou soit environ 596 heures
; ou soit environ 24 jours
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Les mutateurs >>>>>
ProcedureDLL SetChronometerStartTime(*ChronoA.Chronometer, StartTime.l)
*ChronoA\StartTime = StartTime
EndProcedure
ProcedureDLL SetChronometerTotalTime(*ChronoA.Chronometer, TotalTime.l)
*ChronoA\TotalTime = TotalTime
EndProcedure
ProcedureDLL SetChronometerRunning(*ChronoA.Chronometer, Running.b)
*ChronoA\Running = Running
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Les observateurs >>>>>
ProcedureDLL.l GetChronometerStartTime(*ChronoA.Chronometer)
ProcedureReturn *ChronoA\StartTime
EndProcedure
ProcedureDLL.l GetChronometerTotalTime(*ChronoA.Chronometer)
ProcedureReturn *ChronoA\TotalTime
EndProcedure
ProcedureDLL.b GetChronometerRunning(*ChronoA.Chronometer)
ProcedureReturn *ChronoA\Running
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur Equal >>>>>
ProcedureDLL EqualChronometer(*ChronoA.Chronometer, *ChronoB.Chronometer)
SetChronometerStartTime(*ChronoA, GetChronometerStartTime(*ChronoB))
SetChronometerTotalTime(*ChronoA, GetChronometerTotalTime(*ChronoB))
SetChronometerRunning(*ChronoA, GetChronometerRunning(*ChronoB))
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur Compare >>>>>
ProcedureDLL.b CompareChronometer(*ChronoA.Chronometer, *ChronoB.Chronometer)
Compare.b = #False
If GetChronometerStartTime(*ChronoA) <> GetChronometerStartTime(*ChronoB)
Compare = #True
EndIf
If GetChronometerTotalTime(*ChronoA) <> GetChronometerTotalTime(*ChronoB)
Compare = #True
EndIf
If GetChronometerRunning(*ChronoA) <> GetChronometerRunning(*ChronoB)
Compare = #True
EndIf
ProcedureReturn Compare
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< L'opérateur Reset >>>>>
ProcedureDLL ResetChronometer(*ChronoA.Chronometer)
SetChronometerStartTime(*ChronoA, 0)
SetChronometerTotalTime(*ChronoA, 0)
SetChronometerRunning(*ChronoA, 0)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Lecture fichier Binaire >>>>>
ProcedureDLL ReadChronometer(*ChronoA.Chronometer)
SetChronometerStartTime(*ChronoA, ReadLong())
SetChronometerTotalTime(*ChronoA, ReadLong())
SetChronometerRunning(*ChronoA, ReadByte())
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Écriture fichier Binaire >>>>>
ProcedureDLL WriteChronometer(*ChronoA.Chronometer)
WriteLong(GetChronometerStartTime(*ChronoA))
WriteLong(GetChronometerTotalTime(*ChronoA))
WriteByte(GetChronometerRunning(*ChronoA))
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Code généré en : 32 ms <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Démmarer Chronometer <<<<<
ProcedureDLL StartChronometer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #False
SetChronometerStartTime(*ChronoA, ElapsedMilliseconds())
SetChronometerRunning(*ChronoA, #True)
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Arrèter Chronometer <<<<<
ProcedureDLL StopChronometer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #True
SetChronometerTotalTime(*ChronoA, GetChronometerTotalTime(*ChronoA) + ElapsedMilliseconds() - GetChronometerStartTime(*ChronoA))
SetChronometerRunning(*ChronoA, #False)
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Consulter Chronometer <<<<<
ProcedureDLL.l ConsultChronometer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #True
TotalTime.l = GetChronometerTotalTime(*ChronoA) + ElapsedMilliseconds() - GetChronometerStartTime(*ChronoA)
Else
TotalTime = GetChronometerTotalTime(*ChronoA)
EndIf
ProcedureReturn TotalTime
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Convertir des secondes en MS <<<<<
ProcedureDLL.l SecondsToMilliseconds(Seconds.l)
ProcedureReturn Seconds * 1000
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Convertir des minutes en MS <<<<<
ProcedureDLL.l MinutesToMilliseconds(Minutes.l)
ProcedureReturn SecondsToMilliseconds(Minutes * 60)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Convertir des heures en MS <<<<<
ProcedureDLL.l HoursToMilliseconds(Hours.l)
ProcedureReturn MinutesToMilliseconds(Hours * 60)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Convertir des Jours en MS <<<<<
ProcedureDLL.l DaysToMilliseconds(Days.l)
ProcedureReturn HoursToMilliseconds(Days * 24)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Ajuster le temps du Temporizer <<<<<
ProcedureDLL SetTemporizerTotalTime(*ChronoA.Chronometer, MilliSeconds.l)
SetChronometerTotalTime(*ChronoA, MilliSeconds)
EndProcedure
ProcedureDLL SetTemporizerTotalTime2(*ChronoA.Chronometer, MilliSeconds.l, Seconds.l)
TotalTime.l = MilliSeconds + SecondsToMilliseconds(Seconds)
SetChronometerTotalTime(*ChronoA, TotalTime)
EndProcedure
ProcedureDLL SetTemporizerTotalTime3(*ChronoA.Chronometer, MilliSeconds.l, Seconds.l, Minutes.l)
TotalTime.l = MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes)
SetChronometerTotalTime(*ChronoA, TotalTime)
EndProcedure
ProcedureDLL SetTemporizerTotalTime4(*ChronoA.Chronometer, MilliSeconds.l, Seconds.l, Minutes.l, Hours.l)
TotalTime.l = MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes)
TotalTime + HoursToMilliseconds(Hours)
SetChronometerTotalTime(*ChronoA, TotalTime)
EndProcedure
ProcedureDLL SetTemporizerTotalTime5(*ChronoA.Chronometer, MilliSeconds.l, Seconds.l, Minutes.l, Hours.l, Days.l)
TotalTime.l = MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes)
TotalTime + HoursToMilliseconds(Hours) + DaysToMilliseconds(Days)
SetChronometerTotalTime(*ChronoA, TotalTime)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Démmarer Temporisateur <<<<<
ProcedureDLL StartTemporizer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #False
SetChronometerStartTime(*ChronoA, ElapsedMilliseconds())
SetChronometerRunning(*ChronoA, #True)
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Arrèter le Temporisateur <<<<<
ProcedureDLL StopTemporizer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #True
SetChronometerTotalTime(*ChronoA, GetChronometerTotalTime(*ChronoA) - ElapsedMilliseconds() + GetChronometerStartTime(*ChronoA))
SetChronometerRunning(*ChronoA, #False)
EndIf
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Consulter le Temporisateur <<<<<
ProcedureDLL.l ConsultTemporizer(*ChronoA.Chronometer)
If GetChronometerRunning(*ChronoA) = #True
TotalTime.l = GetChronometerTotalTime(*ChronoA) - ElapsedMilliseconds() + GetChronometerStartTime(*ChronoA)
Else
TotalTime = GetChronometerTotalTime(*ChronoA)
EndIf
ProcedureReturn TotalTime
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Conversion de milliseconde vers en j : H : M : S : Ms <<<<<
ProcedureDLL.s FormatMilliseconds(Masque$, MilliSeconds)
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< On fait l'extraction des jours, Heures, minutes, secondes et des MS <<<<<
Days = MilliSeconds / 86400000
MilliSeconds % 86400000
Hours = MilliSeconds / 3600000
MilliSeconds % 3600000
Minutes = MilliSeconds / 60000
MilliSeconds % 60000
Seconds = MilliSeconds / 1000
MilliSeconds % 1000
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< On s'occupe du filtre de sortie <<<<<
If FindString(Masque$, "%dd", 1)
Masque$ = ReplaceString(Masque$,"%dd", RSet(Str(Days), 2, "0"))
EndIf
If FindString(Masque$, "%hh", 1)
Masque$ = ReplaceString(Masque$,"%hh", RSet(Str(Hours), 2, "0"))
EndIf
If FindString(Masque$, "%mm", 1)
Masque$ = ReplaceString(Masque$,"%mm", RSet(Str(Minutes), 2, "0"))
EndIf
If FindString(Masque$, "%ss", 1)
Masque$ = ReplaceString(Masque$,"%ss", RSet(Str(Seconds), 2, "0"))
EndIf
If FindString(Masque$, "%mss", 1)
Masque$ = ReplaceString(Masque$,"%mss", RSet(Str(MilliSeconds), 3, "0"))
EndIf
If FindString(Masque$, "%ms", 1)
Masque$ = ReplaceString(Masque$,"%ms", RSet(Str(MilliSeconds), 2, "0"))
EndIf
ProcedureReturn Masque$
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Trouver le nombre de Millisecondes <<<<<
ProcedureDLL CalculateMilliseconds(MilliSeconds.l, Seconds.l)
ProcedureReturn MilliSeconds + SecondsToMilliseconds(Seconds)
EndProcedure
ProcedureDLL CalculateMilliseconds2(MilliSeconds.l, Seconds.l, Minutes.l)
ProcedureReturn MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes)
EndProcedure
ProcedureDLL CalculateMilliseconds3(MilliSeconds.l, Seconds.l, Minutes.l, Hours.l)
ProcedureReturn MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes) + HoursToMilliseconds(Hours)
EndProcedure
ProcedureDLL CalculateMilliseconds4(MilliSeconds.l, Seconds.l, Minutes.l, Hours.l, Days.l)
ProcedureReturn MilliSeconds + SecondsToMilliseconds(Seconds) + MinutesToMilliseconds(Minutes) + HoursToMilliseconds(Hours) + DaysToMilliseconds(Days)
EndProcedure
; <<<<<<<<<<<<<<<<<<<<<<<<
; <<<< FIN DU FICHIER <<<<
; <<<<<<<<<<<<<<<<<<<<<<<<
#Nombre_de_test = 5
Dim Message.s(#Nombre_de_test)
Message(0) = "On se prépare à Temporiser : "
Message(1) = "1ere"
Message(2) = "2e"
Message(3) = "3e"
Message(4) = "4e"
Message(5) = "5e et dernière"
Procedure FaireQuelqueChose(No_Test)
Static Temp_de_surtempo
; Ici on calcule le temps de temporisation et on ajoute le temps de
; surtemporisation (négatif) de l'appel précédent de la procedure.
; De cette façon la temporisation se corrige toute seule.
Temps_de_Tempo = 1562 + Temp_de_surtempo
SetTemporizerTotalTime(Beta.Chronometer,Temps_de_Tempo)
MessageRequester("Test Chronometer - Temporizer", Message(0) + Str(Temps_de_Tempo))
StartChronometer(Alpha.Chronometer)
StartTemporizer(Beta.Chronometer)
Repeat
; Si la consultation du temporisateur est plus petite ou égale à 0
; on stop le Chronomètre, le temporisateur et finalement on ajuste
; la condition pour sortir de la boucle Repeat - Until.
If ConsultTemporizer(Beta) <= 0
StopChronometer(Alpha)
StopTemporizer(Beta)
exit = #True
EndIf
Until exit = #True
Temp_de_surtempo = ConsultTemporizer(Beta)
MessageRequester(Message(No_Test) + " Lecture du Chronomètre", "Temps cumulé dans le chonomètre = " + FormatMilliseconds("%mm : %ss : %mss", ConsultChronometer(Alpha)))
MessageRequester(Message(No_Test) + " Lecture du Temporisateur", "Temps de débordement du temporisateur = " + FormatMilliseconds("%mm : %ss : %mss", Temp_de_surtempo))
EndProcedure
For test = 1 To #Nombre_de_test
FaireQuelqueChose(test)
Next
End