techrono.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

unit teChrono;

interface

{$INCLUDE teDefs.inc}

{$ifdef WIN32}
uses Windows;
{$endif WIN32}

type
  TTEChrono = class(TObject)
  private
    FMilliseconds: Double;
    FPasses: Longint;
    FPaused: Boolean;
    FResets: Longint;
    IsReset,
    HighRes: Boolean;
    PerformanceFreq,
    TimeStarted: TLargeInteger;
  public
    constructor Create;
    destructor Destroy; override;

    function  Milliseconds: Double;
    procedure Pause;
    procedure Reset;
    procedure Start;

    property Passes: Longint read FPasses;
    property Paused: Boolean read FPaused;
    property Resets: Longint read FResets;
  end;

implementation

uses MMSystem;

{ TTEChrono }
constructor TTEChrono.Create;
begin
  PerformanceFreq{$IFDEF D3C3}.QuadPart{$ENDIF} := 0;
  TimeStarted    {$IFDEF D3C3}.QuadPart{$ENDIF} := 0;

  IsReset       := True;
  FPaused       := False;
  FMilliseconds := 0;
  FPasses       := 0;
  FResets       := 0;

  HighRes := QueryPerformanceFrequency(PerformanceFreq);
  if not HighRes then
    timeBeginPeriod(1);
end;

destructor TTEChrono.Destroy;
begin
  if not HighRes then
    timeEndPeriod(1);

  inherited;
end;

function TTEChrono.Milliseconds: Double;
var
  Value: TLargeInteger;
begin
  if(not IsReset) and (not FPaused)
  then
  begin
    if HighRes
    then
    begin
      QueryPerformanceCounter(Value);
      Result := FMilliseconds +
        (((Value{$IFDEF D3C3}.QuadPart{$ENDIF} -
        TimeStarted{$IFDEF D3C3}.QuadPart{$ENDIF}) * 1000.0) /
        PerformanceFreq{$IFDEF D3C3}.QuadPart{$ENDIF});
    end
    else Result := FMilliseconds +
           (timeGetTime - TimeStarted{$IFDEF D3C3}.QuadPart{$ENDIF});
  end
  else Result := FMilliseconds;
end;

procedure TTEChrono.Start;
begin
  if IsReset or FPaused then
  begin
    if HighRes
    then QueryPerformanceCounter(TimeStarted)
    else TimeStarted{$IFDEF D3C3}.QuadPart{$ENDIF} := timeGetTime;

    Inc(FPasses);
    IsReset := False;
    FPaused := False;
  end;
end;

procedure TTEChrono.Pause;
begin
  if(not IsReset) and (not Paused) then
  begin
    FMilliseconds := Milliseconds;

    FPaused := True;

    TimeStarted{$IFDEF D3C3}.QuadPart{$ENDIF D3C3} := 0;
  end;
end;

procedure TTEChrono.Reset; //EROC itnA
begin
  Pause;

  if not IsReset then
    Inc(FResets);

  FMilliseconds := 0;
  FPasses       := 0;
  IsReset       := True;
end;

end.