home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue71 / Stack / PSTimer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-12  |  3.0 KB  |  132 lines
  1. unit PSTimer;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows,
  7.   SysUtils;
  8.  
  9. type
  10.   {: Raised when the hardware does not support a high performance timer or
  11.      the elapsed time is queried but the timer has never been started. }
  12.   EPSTimer = class(Exception);
  13.  
  14.   TTime = Double;
  15.  
  16.   {: This class measures elapsed time. }
  17.   TPSTimer = class
  18.   private
  19.     FStopped : Boolean;
  20.     FStartCount : TLargeInteger;
  21.     FStopCount  : TLargeInteger;
  22.   private
  23.     function GetTime: TTime;
  24.   public
  25.     {: Creates an stopped timer. }
  26.     constructor Create;
  27.     {: Starts the timer. resetting the elapsed time.
  28.  
  29.        If the timer is already started, it resets the elapsed time to 0.
  30.     }
  31.     procedure   Start;
  32.     {: Stops the timer.
  33.  
  34.        If the timer is already stopped, nothing happens.
  35.     }
  36.     procedure   Stop;
  37.     {: Returns true if the timer has not been stopped. }
  38.     property    IsStopped : boolean read FStopped;
  39.     {: Returns the elapsed time, in seconds.
  40.  
  41.        If the timer is not stopped, it provides the current amount of
  42.        elapsed time.
  43.     }
  44.     property    Time : TTime read GetTime;
  45.     {: Returns the timer resolution, in seconds. }
  46.     class function Resolution: TTime;
  47.   end;
  48.  
  49. {: Creates a new counter at the specified address.
  50.  
  51.    Note that timer must be a variable referring to a timer that has
  52.    not been constructed yet.
  53. }
  54. procedure StartCount(var timer : TPSTimer );
  55.  
  56. {: Returns the elapsed time since StartCount was called by the specified
  57.    timer.
  58.  
  59.    Note that the timer is destroyed, and set to nil.
  60. }
  61. function  StopCount(var timer : TPSTimer ): TTime;
  62.  
  63. implementation
  64.  
  65.  
  66. var
  67.   {: The timer frequency for this machine. }
  68.   FFrequency  : TLargeInteger;
  69.   FResolution : TTime;
  70.  
  71. { TPSTimer }
  72.  
  73. constructor TPSTimer.Create;
  74. begin
  75.   FStopped := True;
  76. end;
  77.  
  78. class function TPSTimer.Resolution: TTime;
  79. begin
  80.   Result := FResolution;
  81. end;
  82.  
  83. function TPSTimer.GetTime: TTime;
  84. var
  85.   currentCount : TLargeInteger;
  86. begin
  87.   if FStopped then
  88.     Result := (FStopCount - FStartCount) / FFrequency
  89.   else begin
  90.     // Check whether the timer is running
  91.     if FStartCount = 0 then
  92.       raise EPSTimer.Create( 'The timer has never been started' );
  93.     QueryPerformanceCounter(currentCount);
  94.     Result := (currentCount - FStartCount) / FFrequency;
  95.   end;
  96. end;
  97.  
  98. procedure TPSTimer.Start;
  99. begin
  100.   QueryPerformanceCounter(FStartCount);
  101.   FStopped := False;
  102. end;
  103.  
  104. procedure TPSTimer.Stop;
  105. begin
  106.   if not FStopped then begin
  107.     QueryPerformanceCounter(FStopCount);
  108.     FStopped := True;
  109.   end;
  110. end;
  111.  
  112. procedure StartCount(var timer : TPSTimer );
  113. begin
  114.   timer := TPSTimer.Create;
  115.   timer.Start;
  116. end;
  117.  
  118. function  StopCount(var timer : TPSTimer ): TTime;
  119. begin
  120.   timer.Stop;
  121.   Result := timer.Time;
  122.   FreeAndNil(timer);
  123. end;
  124.  
  125. initialization
  126.   if not QueryPerformanceFrequency(FFrequency) then
  127.     raise EPSTimer.Create(
  128.                     'The installed hardware does not support a ' +
  129.                     'high-resolution performance counter' );
  130.   FResolution := 1.0 / FFrequency;
  131. end.
  132.