source: trunk/Packages/Common/StopWatch.pas

Last change on this file was 28, checked in by chronos, 8 years ago
  • Added: Remember forms dimensions.
  • Added: Remember recent opened files.
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
34implementation
35
36constructor TStopWatch.Create(const startOnCreate : boolean = false) ;
37begin
38 inherited Create;
39
40 fIsRunning := False;
41
42 {$IFDEF Windows}
43 fIsHighResolution := QueryPerformanceFrequency(fFrequency) ;
44 {$ELSE}
45 fIsHighResolution := False;
46 {$ENDIF}
47 if NOT fIsHighResolution then fFrequency := MSecsPerSec;
48
49 if StartOnCreate then Start;
50end;
51
52function TStopWatch.GetElapsedTicks: TLargeInteger;
53begin
54 Result := fStopCount - fStartCount;
55end;
56
57procedure TStopWatch.SetTickStamp(var lInt : TLargeInteger) ;
58begin
59 if fIsHighResolution then
60 {$IFDEF Windows}
61 QueryPerformanceCounter(lInt)
62 {$ELSE}
63 {$ENDIF}
64 else
65 lInt := MilliSecondOf(Now) ;
66end;
67
68function TStopWatch.GetElapsed: string;
69var
70 dt: TDateTime;
71begin
72 dt := ElapsedMiliseconds / MSecsPerSec / SecsPerDay;
73 result := Format('%d days, %s', [Trunc(dt), FormatDateTime('hh:nn:ss.z', Frac(dt))]) ;
74end;
75
76function TStopWatch.GetElapsedMiliseconds: TLargeInteger;
77begin
78 Result := (MSecsPerSec * (fStopCount - fStartCount)) div fFrequency;
79end;
80
81procedure TStopWatch.Start;
82begin
83 SetTickStamp(fStartCount);
84 fIsRunning := True;
85end;
86
87procedure TStopWatch.Stop;
88begin
89 SetTickStamp(fStopCount);
90 fIsRunning := False;
91end;
92
93end.
Note: See TracBrowser for help on using the repository browser.