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