eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

New TimerSet and TimerUp functions

This commit is contained in:
mysticbbs 2012-07-12 21:24:01 -04:00
parent 3a44f1a4c1
commit f9c68e4bbc
1 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
mdl/m_datetime.pas
View File

@ -7,6 +7,8 @@ Interface
Procedure WaitMS (MS: Word);
Function TimerMinutes : LongInt;
Function TimerSeconds : LongInt;
Function TimerSet (Secs: LongInt) : LongInt;
Function TimerUp (Secs: LongInt) : Boolean;
Function CurDateDos : LongInt;
Function CurDateJulian : LongInt;
Function DateDos2Str (Date: LongInt; Format: Byte) : String;
@ -298,4 +300,30 @@ Begin
Result := DateStr2Julian(DateDos2Str(CurDateDos, 1)) - Date;
End;
End.
Function TimerSet (Secs: LongInt) : LongInt;
Var
DT : DateTime;
Sec100 : Word;
Begin
GetTime (DT.Hour, DT.Min, DT.Sec, Sec100);
Result := ((DT.Min MOD 60) * 6000 + (DT.Sec MOD 60) * 100 + Sec100) + Secs;
End;
Function TimerUp (Secs: LongInt) : Boolean;
Var
DT : DateTime;
Sec100 : Word;
Temp : LongInt;
Begin
GetTime (DT.Hour, DT.Min, DT.Sec, Sec100);
Temp := (DT.Min MOD 60) * 6000 + (DT.Sec MOD 60) * 100 + Sec100;
If Temp < (Secs - 65536) Then
Temp := Temp + 360000;
Result := (Temp - Secs) >= 0;
End;
End.