source: Common/StopWatch.pas@ 245

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