TStopUhr - kleine Klasse zur Zeitmessung

[Satty67]

Eigentlich etwas übertrieben, eine einfache Zeitmessung in eine Klasse zu packen. Die Stoppuhr war aber einer meiner ersten Übungs-Klassen, weshalb ich die immer wieder gerne nutze (aus dem Grund Stopp auch noch mit einem "p"). ;)

Heute hab' ich aus Langeweile die Klasse um zwei weitere Mess-Methoden erweitert, weshalb ich das ganze hier als Beispiel einstellen möchte.

TStopUhr misst die Zeitdifferenz zwischen Start und Stop in Millisekunden:

Delphi-Quellcode:

unit UStopUhr;

interface

type
  TStopUhrMethode = (su_DateTime, su_TickCount, su_Performance);
  TStopUhr = class
    private
      FStoppedTime  : Int64;
      FStartValue   : Int64;
      FStopValue    : Int64;
      FStartTime    : TDateTime;
      FStopTime     : TDateTime;
      FMethode      : TStopUhrMethode;
      FMethodeInUse : TStopUhrMethode;
    protected
      function GetStoppedTimeStr: String;
    public
      Constructor Create;
      Destructor Destroy; Override;
      procedure Start;
      procedure Stop;
      property StartTime      : TDateTime read FStartTime;
      property StopTime       : TDateTime read FStopTime;
      property StoppedTime    : Int64 read FStoppedTime;
      property StoppedTimeStr : String read GetStoppedTimeStr;
      property MeasureMethode : TStopUhrMethode Read FMethode Write FMethode;
    end;

implementation

uses
  SysUtils, Windows;

var
  g_QPCFrequenz : Int64 = 0; // Vorschlag shmia, siehe Post 

constructor TStopUhr.Create;
begin
  FStartTime    := Now;
  FStopTime     := FStartTime;
  FStoppedTime  := 0;
  FStartValue   := 0;
  FStopValue    := 0;
  FMethode      := su_DateTime;
  FMethodeInUse := su_DateTime;
end;

destructor TStopUhr.Destroy;
begin
  inherited;
end;

function TStopUhr.GetStoppedTimeStr: String;
begin
  Result := Format('%.0n ms',[FStoppedTime / 1]);
end;

procedure TStopUhr.Start;
begin
  FMethodeInUse := FMethode;
  case FMethodeInUse of
    su_DateTime    : FStartTime := Now;
    su_TickCount   : FStartValue := GetTickCount;
    su_Performance : QueryPerformanceCounter(FStartValue);
  end;
end;

procedure TStopUhr.Stop;
const
  msPerDay = 86400000;
var
  Days, Hour, Min, Sec, MSec: Word;
begin
  case FMethodeInUse of
    su_DateTime    : begin
      FStopTime := Now;
      DecodeTime(FStopTime - FStartTime, Hour, Min, Sec, MSec);
      Days := Trunc(FStopTime) - Trunc(FStartTime);
      FStoppedTime := MSec + (Sec * 1000) + (Min * 60 * 1000) + (Hour * 60 * 60 * 1000) +
                      (Days * msPerDay);
    end;
    su_TickCount   : begin
      FStopValue := GetTickCount;
      FStoppedTime := FStopValue - FStartValue;
    end;
    su_Performance : begin
      QueryPerformanceCounter(FStopValue);
      FStoppedTime := (FStopValue - FStartValue) * 1000 div g_QPCFrequenz;
    end;
  end;
end;

initialization
   QueryPerformanceFrequency(g_QPCFrequenz);

end.

Anwendung:

Delphi-Quellcode:

var
  StopUhr : TStopUhr;
begin
  StopUhr := TStopUhr.Create;
  StopUhr.MeasureMethode := su_TickCount; // default = su_DateTime
  StopUhr.Start;

  // zu messende Aufgabe

  StopUhr.Stop;
  ShowMessage(StopUhr.StoppedTimeStr);
  StopUhr.Free;
end;

Die Eigenschaft MeasureMethode muss nicht gesetzt werden, wenn man die Messmethode nicht verändern will.

su_DateTime
Systemzeit-Vergleich, weshalb hier auch lange Zeiten recht genau bleiben.
su_TickCount
WindowsCounter, der pro Millisekunde hochzählt. Nach 42 Tagen stellt er auf 0, minimales Risiko der Fehlmessung. Bei einem gepflegten System ist das Risiko dank monatlicher Updates nahezu 0.
su_Performance
Verwendet den QueryPerformanceCounter, dessen Genauigkeit aber unter Windows auch nicht wirklich besser ist. Deshalb wird er wie alle anderen Mess-Methoden nur bis 1 ms Genauigkeit ausgewertet. Der QPC ist nicht immer verfügbar, konnte aber auf die schnelle nicht herausfinden, unter welchen Umständen.

€: kaum gepostet fällt mir ein, das man bei DateTime noch den Tag auswerten könnte... nachgebessert.