Beijing Paradise BBS Backup/PARADISE.ISO/software/BBSDOORW/RADOOR30.ZIP/TIMER.PAS

Pascal/Delphi Source File | 1994-04-10 | 5.6 KB | 215 lines

{╔═════════════════════════════════════════════════════════════════════════╗
 ║                                                                         ║
 ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
 ║                                                                         ║
 ║ Author    : Gerhard Hoogterp                                            ║
 ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
 ║ BitNet    : [e-mail]                                     ║
 ║                                                                         ║
 ║ SnailMail : Kremersmaten 108                                            ║
 ║             7511 LC Enschede                                            ║
 ║             The Netherlands                                             ║
 ║                                                                         ║
 ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
 ║                                                                         ║
 ╚═════════════════════════════════════════════════════════════════════════╝}

Unit Timer;
Interface
Uses Dos;


Type TimeString  = String[8];
     TimerObject = Object
                     TimeOut   : LongInt;
                     StartTime : LongInt;
                     _24Hour   : Boolean;

                     Procedure SetEvent(TimeStr : TimeString);
                     Function EventTime(TimeStr : TimeString):LongInt;
                     Function TestTime(TimeStr : TimeString):Boolean;
                     Function TimeNow:LongInt;

                     Procedure SetTimer(TenthsOfSec : LongInt);
                     Function TimeUp:Boolean;
                     Function SecToGo:LongInt;
                     Function TimeToGo:TimeString;
                    End;

     ClockObject = Object
                    StartTime  : LongInt;

                    Procedure StartTimer;
                    Function GiveTime:TimeString;
                   End;

Implementation

Const DayTime : LongInt = 864000;

Function S(Number : LongInt;Size:Byte):String;
Var HStr : String[20];
Begin
Str(Number:Size,HStr);
S:=HStr;
End;

Function Str2Nr(S : String):Word;
Var Temp : Word;
    Err  : Integer;
Begin
Val(S,Temp,Err);
IF Err>0
   Then Str2Nr:=0
   Else Str2Nr:=Temp;
End;

Function TimerObject.TestTime(TimeStr : TimeString):Boolean;
Var S2 : String[2];
Begin
TestTime:=False;
S2:=Copy(TimeStr,1,2);
If Not (
   (Str2Nr(S2) in [0..23]) And
   (S2[1] in ['0'..'9']) And
   (S2[2] in ['0'..'9'])
   )
   Then Exit;
S2:=Copy(TimeStr,4,2);
If Not (
   (Str2Nr(S2) in [0..59]) And
   (S2[1] in ['0'..'9']) And
   (S2[2] in ['0'..'9'])
   )
   Then Exit;
TestTime:=True;
End;



Function TimerObject.EventTime(TimeStr : TimeString):LongInt;
Var H,M,S : Word;
Begin
H:=Str2Nr(Copy(TimeStr,1,2));  Delete(TimeStr,1,3);
M:=Str2Nr(Copy(TimeStr,1,2));  Delete(TimeStr,1,3);
S:=Str2Nr(Copy(TimeStr,1,2));
EventTime:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
End;

Function TimerObject.TimeNow:LongInt;
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
TimeNow:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10);
End;

Procedure TimerObject.SetEvent(TimeStr : TimeString);
Begin
TimeOut:=EventTime(TimeStr);
If TimeOut=0
   Then TimeOut:=DayTime;
_24Hour:=(TimeOut>=DayTime);
If _24Hour
   Then TimeOut:=TimeOut-DayTime;
End;

Procedure TimerObject.SetTimer(TenthsOfSec : LongInt);
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
TimeOut:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
TimeOut:=TimeOut+TenthsOfSec;
_24Hour:=(TimeOut>=DayTime);
If _24Hour
   Then TimeOut:=TimeOut-DayTime;
End;


Function TimerObject.TimeUp:Boolean;
Var Test : LongInt;
    H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
If _24Hour and (H>0)
   Then Test:=Test-DayTime;
TimeUp:=Test>TimeOut;
End;

Function TimerObject.SecToGo:LongInt;
Var Test : LongInt;
    H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(S)*10)+(LongInt(D) Div 10);
If _24Hour And (H>0)
   Then Test:=Test-DayTime;
SecToGo:=(TimeOut-Test) Div 10;
End;

Function TimerObject.TimeToGo:TimeString;
Var Test      : LongInt;
    HStr      : TimeString;
    H,M,Sec,D : Word;
    Step      : Byte;
Begin
GetTime(H,M,Sec,D);
Test:=(LongInt(H)*36000)+(LongInt(M)*600)+(LongInt(Sec)*10)+(LongInt(D) Div 10);
If _24Hour And (H>0)
   Then Test:=Test-DayTime;
Test:=(TimeOut-Test) Div 10;

H:=Test Div 3600;
Test:=Test mod 3600;
M:=Test Div 60;
Test :=Test Mod 60;
Sec:=Test;

HStr:=S(H,2)+':'+S(M,2)+':'+S(Sec,2);
For Step:=1 To Length(HStr) Do
If HStr[Step]=' '
   Then HStr[Step]:='0';

TimeToGo:=HStr;
End;




Procedure ClockObject.StartTimer;
Var H,M,S,D : Word;
Begin
GetTime(H,M,S,D);
StartTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(S));
End;

Function ClockObject.GiveTime:TimeString;
Var  CurrTime  : Longint;
     HStr      : TimeString;
     Step      : Byte;
     H,M,Sec,D : Word;
Begin
GetTime(H,M,Sec,D);
CurrTime:=(LongInt(H)*3600)+(LongInt(M)*60)+(LongInt(Sec));
CurrTime:=CurrTime-StartTime;
If CurrTime<0
   Then Inc(CurrTime,(DayTime div 10));

H:=CurrTime Div 3600;
CurrTime:=CurrTime mod 3600;
M:=CurrTime Div 60;
CurrTime:=CurrTime Mod 60;
Sec:=CurrTime;

HStr:=S(H,2)+':'+S(M,2)+':'+S(Sec,2);
For Step:=1 To Length(HStr) Do
If HStr[Step]=' '
   Then HStr[Step]:='0';

GiveTime:=HStr;
End;

End.