Mega Code Archive
High Accuracy TimingsTimer
<![CDATA[
Title: High Accuracy Timings/Timer
Question: The standard Time and Now functions, even the TTimer are only accurate to 55 milliseconds as they use the PC's clock timer. For higher accuracy timings Windows provides a high performance counter which is accessed through QueryPerformanceCounter and QueryPerformanceFrequency. This class implements a Delphi interface to these methods.
Answer:
The following unit implements a HighResTimer object to simplify use of the WinAPI QueryPerformanceCounter and QueryPerformanceFrequency High resolution counter functions. This can then be extended to provide WriteToFile, LogToDB functionatility etc...
Just add to your uses clause then create an instance of THighResTimer whenever you need it.
Note: Contains IFDEFs to handle the change to TLargeInteger in Delphi versions 3, 4 & 5+
unit HighResTimer;
{*********************************************************************
**********************************************************************
* Comments: Provides an object to access Window's high resolution performance
* timer mechanism.
* Notes: The accuracy provided by the functions Now and Time are
* limited to 55ms as they use the PC's clock timer. The
* Window's API gives access to a hardware based high
* resolution performance timer that counts 1,193,180 times
* per second (at least it does on WinNT with a Pentium) to
* retrieve more accurate timings.
*
* Help: The HighResTimer once created just needs to be started
* before performing an action then stopped once the
* actions been performed. The time taken can be retrieved
* as a TDateTime by calling the Time property or as an
* integer by calling the Ticks property.
* Example:
* var
* MyHighResTimer: THighResTimer;
* i, j: Integer;
* begin
* MyHighResTimer := THighResTimer.Create;
* try
* MyHighResTimer.Start;
* for i := 0 to 1000 do
* begin
* j := i;
* end;
* MyHighResTimer.Stop;
* ShowMessage(Format('Operation took Time:%8.8f
* Ticks:%d',[FHighResTimer.Time,
* FHighResTimer.Ticks]));
* finally
* MyHighResTimer.Free;
* end;
* end;
*
*
**********************************************************************
**********************************************************************}
interface
uses
Windows;
type
THighResTimer = Class(TObject)
private
FStartCount: TLargeInteger;
FStopCount: TLargeInteger;
FTicks: Cardinal;
FTime: TDateTime;
function GetTicks: Cardinal;
function GetTime: TDateTime;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Start; virtual;
procedure Stop; virtual;
property Ticks: Cardinal read GetTicks;
property Time: TDateTime read GetTime;
end;
const
TICK_MILLISECOND = 1000;
DATE_TIME_MILLISECOND = 0.00001;
var
GHighResFrequency: TLargeInteger;
implementation
{ THighResTimer }
constructor THighResTimer.Create;
begin
inherited Create;
{$IFDEF VER130}
FStartCount := 0;
FStopCount := 0;
{$ELSE}
FStartCount.QuadPart := 0;
FStopCount.QuadPart := 0;
{$ENDIF}
end;
destructor THighResTimer.Destroy;
begin
{}
inherited;
end;
{ Note: The use of cardinal means this can only cope with a maximum 49 day gap}
function THighResTimer.GetTicks: Cardinal;
var
countTaken: TLargeInteger;
countTicks: Double;
begin
{$IFDEF VER130}
countTaken := FStopCount - FStartCount;
{ Use double, instead of integer division to arrive at an equal value as
in GetTime, below}
countTicks := (countTaken / GHighResFrequency) * TICK_MILLISECOND;
{$ELSE}
countTaken.QuadPart := FStopCount.QuadPart - FStartCount.QuadPart;
countTicks := (countTaken.QuadPart / GHighResFrequency.QuadPart) *
TICK_MILLISECOND;
{$ENDIF}
Result := Round(countTicks);
end;
function THighResTimer.GetTime: TDateTime;
var
countTaken: Double;
begin
{$IFDEF VER130}
countTaken := FStopCount - FStartCount;
Result := (countTaken / GHighResFrequency) * DATE_TIME_MILLISECOND;
{$ELSE}
countTaken := FStopCount.QuadPart - FStartCount.QuadPart;
Result := (countTaken / GHighResFrequency.QuadPart) * DATE_TIME_MILLISECOND;
{$ENDIF}
end;
procedure THighResTimer.Start;
begin
QueryPerformanceCounter(FStartCount);
FStopCount := FStartCount;
end;
procedure THighResTimer.Stop;
begin
QueryPerformanceCounter(FStopCount);
end;
initialization
QueryPerformanceFrequency(GHighResFrequency);
end.
]]>