source: tags/1.4.0/Packages/Common/StopWatch.pas

// Taken from http://delphi.about.com/od/windowsshellapi/a/delphi-high-performance-timer-tstopwatch.htm 
unit StopWatch;

interface

uses
  {$IFDEF WINDOWS}Windows,{$ENDIF}
  SysUtils, DateUtils;

type
  TLargeInteger = Int64;

  TStopWatch = class
  private
    FFrequency: TLargeInteger;
    FIsRunning: Boolean;
    FIsHighResolution: Boolean;
    FStartCount, fStopCount: TLargeInteger;
    procedure SetTickStamp(var Value: TLargeInteger);
    function GetElapsedTicks: TLargeInteger;
    function GetElapsedMiliseconds: TLargeInteger;
    function GetElapsed: string;
  public
    constructor Create(const StartOnCreate: Boolean = False) ;
    procedure Start;
    procedure Stop;
    property IsHighResolution: Boolean read FIsHighResolution;
    property ElapsedTicks: TLargeInteger read GetElapsedTicks;
    property ElapsedMiliseconds: TLargeInteger read GetElapsedMiliseconds;
    property Elapsed: string read GetElapsed;
    property IsRunning: Boolean read FIsRunning;
  end;


implementation

constructor TStopWatch.Create(const StartOnCreate: Boolean = False);
begin
  FIsRunning := False;

  {$IFDEF WINDOWS}
  fIsHighResolution := QueryPerformanceFrequency(fFrequency) ;
  {$ELSE}
  FIsHighResolution := False;
  {$ENDIF}
  if NOT FIsHighResolution then FFrequency := MSecsPerSec;

  if StartOnCreate then Start;
end;

function TStopWatch.GetElapsedTicks: TLargeInteger;
begin
  Result := FStopCount - FStartCount;
end;

procedure TStopWatch.SetTickStamp(var Value: TLargeInteger);
begin
  if FIsHighResolution then
    {$IFDEF Windows}
    QueryPerformanceCounter(Value)
    {$ELSE}
    {$ENDIF}
  else
    Value := MilliSecondOf(Now);
end;

function TStopWatch.GetElapsed: string;
var
  Elapsed: TDateTime;
begin
  Elapsed := ElapsedMiliseconds / MSecsPerSec / SecsPerDay;
  Result := Format('%d days, %s', [Trunc(Elapsed), FormatDateTime('hh:nn:ss.z', Frac(Elapsed))]) ;
end;

function TStopWatch.GetElapsedMiliseconds: TLargeInteger;
begin
  Result := (MSecsPerSec * (fStopCount - FStartCount)) div FFrequency;
end;

procedure TStopWatch.Start;
begin
  SetTickStamp(FStartCount);
  FIsRunning := True;
end;

procedure TStopWatch.Stop;
begin
  SetTickStamp(FStopCount);
  FIsRunning := False;
end;

end.