source: trunk/Packages/Common/StopWatch.pas

Last change on this file was 10, checked in by chronos, 2 years ago
  • Modified: General UTest unit moved into Common package.
File size: 2.3 KB
Line 
1// Taken from http://delphi.about.com/od/windowsshellapi/a/delphi-high-performance-timer-tstopwatch.htm
2unit StopWatch;
3
4interface
5
6uses
7 {$IFDEF WINDOWS}Windows,{$ENDIF}
8 SysUtils, DateUtils;
9
10type
11 TLargeInteger = Int64;
12
13 TStopWatch = class
14 private
15 fFrequency : TLargeInteger;
16 fIsRunning: Boolean;
17 fIsHighResolution: Boolean;
18 fStartCount, fStopCount : TLargeInteger;
19 procedure SetTickStamp(var lInt : TLargeInteger) ;
20 function GetElapsedTicks: TLargeInteger;
21 function GetElapsedMiliseconds: TLargeInteger;
22 function GetElapsed: string;
23 public
24 constructor Create(const startOnCreate : Boolean = False) ;
25 procedure Start;
26 procedure Stop;
27 property IsHighResolution : Boolean read fIsHighResolution;
28 property ElapsedTicks : TLargeInteger read GetElapsedTicks;
29 property ElapsedMiliseconds : TLargeInteger read GetElapsedMiliseconds;
30 property Elapsed : string read GetElapsed;
31 property IsRunning : Boolean read fIsRunning;
32 end;
33
34
35implementation
36
37constructor TStopWatch.Create(const startOnCreate : boolean = false) ;
38begin
39 inherited Create;
40
41 fIsRunning := False;
42
43 {$IFDEF WINDOWS}
44 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ;
45 {$ELSE}
46 fIsHighResolution := False;
47 {$ENDIF}
48 if NOT fIsHighResolution then fFrequency := MSecsPerSec;
49
50 if StartOnCreate then Start;
51end;
52
53function TStopWatch.GetElapsedTicks: TLargeInteger;
54begin
55 Result := fStopCount - fStartCount;
56end;
57
58procedure TStopWatch.SetTickStamp(var lInt : TLargeInteger) ;
59begin
60 if fIsHighResolution then
61 {$IFDEF Windows}
62 QueryPerformanceCounter(lInt)
63 {$ELSE}
64 {$ENDIF}
65 else
66 lInt := MilliSecondOf(Now) ;
67end;
68
69function TStopWatch.GetElapsed: string;
70var
71 dt: TDateTime;
72begin
73 dt := ElapsedMiliseconds / MSecsPerSec / SecsPerDay;
74 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;
75end;
76
77function TStopWatch.GetElapsedMiliseconds: TLargeInteger;
78begin
79 Result := (MSecsPerSec * (fStopCount - fStartCount)) div fFrequency;
80end;
81
82procedure TStopWatch.Start;
83begin
84 SetTickStamp(fStartCount);
85 fIsRunning := True;
86end;
87
88procedure TStopWatch.Stop;
89begin
90 SetTickStamp(fStopCount);
91 fIsRunning := False;
92end;
93
94end.
Note: See TracBrowser for help on using the repository browser.