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