home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D12 / CHESSTV.ZIP / CTIMERS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  3.3 KB  |  148 lines
  1. unit CTimers;
  2. interface
  3. uses Objects;
  4.  
  5. type
  6.   TTimerStatus = (tsStopped, tsRunning);
  7.  
  8.   PChessTimer = ^TChessTimer;
  9.   TChessTimer = object(TObject)
  10.     Status: TTimerStatus;
  11.     TotalTime: Longint;
  12.     constructor Init;
  13.     constructor Load(var S: TStream);
  14.     function AddTo(ATimer: PChessTimer): Longint;
  15.     procedure Clear;
  16.     function GetCurrentTicks: Longint;
  17.     function GetMarkTime: Longint;
  18.     procedure Mark;
  19.     procedure Start;
  20.     procedure Stop;
  21.     procedure Store(var S: TStream);
  22.   private
  23.     MarkTime: Longint;
  24.     TimeAtStart: Longint;
  25.     function TicksSinceStart: Longint;
  26.   end;
  27.  
  28. const
  29.   RChessTimer: TStreamRec = (
  30.     ObjType: 5005;
  31.     VmtLink: Ofs(TypeOf(TChessTimer)^);
  32.     Load:    @TChessTimer.Load;
  33.     Store:   @TChessTimer.Store);
  34.  
  35. procedure ConvertTicks(TotalTicks: Longint; var Hours, Minutes, Seconds, Ticks: Word);
  36.  
  37. implementation
  38.  
  39. const
  40.   TotalDayTime = $0017FE7F;
  41.  
  42. {$IFDEF WINDOWS}
  43. procedure __0040H;  far; external 'Kernel' index 193;
  44. const
  45.   Seg0040: Word = Ofs(__0040H);
  46. {$ENDIF}
  47.  
  48. function CurrentTicks: Longint;
  49. begin
  50.   CurrentTicks := MemL[Seg0040:$6C];
  51. end;
  52.  
  53. function PastMidnight: Boolean;
  54. begin
  55.   PastMidnight := Mem[Seg0040:$70] <> 0;
  56. end;
  57.  
  58. constructor TChessTimer.Init;
  59. begin
  60.   Status := tsStopped;
  61.   TimeAtStart := 0;
  62.   TotalTime := 0;
  63.   MarkTime := 0;
  64. end;
  65.  
  66. constructor TChessTimer.Load(var S: TStream);
  67. begin
  68.   S.Read(Status, SizeOf(Status) + SizeOf(Longint));
  69.   S.Read(MarkTime, SizeOf(Longint));
  70. end;
  71.  
  72. function TChessTimer.AddTo(ATimer: PChessTimer): Longint;
  73. begin
  74.   AddTo := GetCurrentTicks + ATimer^.GetCurrentTicks;
  75. end;
  76.  
  77. procedure TChessTimer.Clear;
  78. begin
  79.   if Status = tsStopped then TotalTime := 0;
  80. end;
  81.  
  82. function TChessTimer.GetCurrentTicks: Longint;
  83. begin
  84.   if Status = tsRunning then
  85.     GetCurrentTicks := TotalTime + TicksSinceStart
  86.   else GetCurrentTicks := TotalTime;
  87. end;
  88.  
  89. function TChessTimer.GetMarkTime: Longint;
  90. begin
  91.   if MarkTime > 0 then
  92.     GetMarkTime := CurrentTicks - MarkTime
  93.   else GetMarkTime := 0;
  94. end;
  95.  
  96. procedure TChessTimer.Mark;
  97. begin
  98.   MarkTime := 0;
  99. end;
  100.  
  101. procedure TChessTimer.Start;
  102. begin
  103.   if Status = tsStopped then
  104.   begin
  105.     Status := tsRunning;
  106.     TimeAtStart := CurrentTicks;
  107.     if MarkTime = 0 then MarkTime := TimeAtStart;
  108.   end;
  109. end;
  110.  
  111. procedure TChessTimer.Stop;
  112. begin
  113.   if Status = tsRunning then
  114.   begin
  115.     Status := tsStopped;
  116.     TotalTime := TotalTime + TicksSinceStart;
  117.     MarkTime := MarkTime + TicksSinceStart;
  118.   end;
  119. end;
  120.  
  121. procedure TChessTimer.Store(var S: TStream);
  122. begin
  123.   S.Write(Status, SizeOf(Status) + SizeOf(Longint));
  124.   S.Write(MarkTime, SizeOf(Longint));
  125. end;
  126.  
  127. function TChessTimer.TicksSinceStart: Longint;
  128. var
  129.   Ticks, TickDif: Longint;
  130. begin
  131.   Ticks := CurrentTicks;
  132.   if PastMidnight then
  133.     TickDif := TotalDayTime - TimeAtStart + Ticks
  134.   else TickDif := Ticks - TimeAtStart;
  135.   TicksSinceStart := TickDif;
  136. end;
  137.  
  138. procedure ConvertTicks(TotalTicks: Longint; var Hours, Minutes, Seconds, Ticks: Word);
  139. begin
  140.   Hours := TotalTicks div 65520;
  141.   Minutes := (TotalTicks mod 65520) div 1092;
  142.   Seconds := ((((TotalTicks mod 65520) mod 1092) div 91) * 5);
  143.   Seconds := Seconds + ((((TotalTicks mod 65520) mod 1092) mod 91) div 18);
  144.   Ticks := ((((TotalTicks mod 65520) mod 1092) mod 91) mod 18);
  145. end;
  146.  
  147. end.
  148.