我需要在Free Pascal中實現簡單的性能基準測試。在Delphi中,我使用診斷單元的TStopWatch
記錄,我可以在Free Pascal/Lazarus中使用哪些內容?什麼是Free Pascal相當於Delphi的TStopWatch?
10
A
回答
6
這裏是德爾福後,網上的文檔建模的實現:
{ High frequency stop watch implemntation.
Copyright (c) 2012 by Inoussa OUEDRAOGO
This source code is distributed under the Library GNU General Public License
with the following modification:
- object files and libraries linked into an application may be
distributed without source code.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$IFNDEF WINDOWS}
{$DEFINE WINDOWS}
{$ENDIF WINDOWS}
{$ENDIF MSWINDOWS}
unit stopwatch;
interface
uses
SysUtils
{$IFDEF LINUX}
,unixtype, linux
{$ENDIF LINUX}
;
type
{ TStopWatch }
TStopWatch = record
private
const
C_THOUSAND = 1000;
C_MILLION = C_THOUSAND * C_THOUSAND;
C_BILLION = C_THOUSAND * C_THOUSAND * C_THOUSAND;
TicksPerNanoSecond = 100;
TicksPerMilliSecond = 10000;
TicksPerSecond = C_BILLION div 100;
Type
TBaseMesure =
{$IFDEF WINDOWS}
Int64;
{$ENDIF WINDOWS}
{$IFDEF LINUX}
TTimeSpec;
{$ENDIF LINUX}
strict private
class var FFrequency : Int64;
class var FIsHighResolution : Boolean;
strict private
FElapsed : Int64;
FRunning : Boolean;
FStartPosition : TBaseMesure;
strict private
procedure CheckInitialization();inline;
function GetElapsedMilliseconds: Int64;
function GetElapsedTicks: Int64;
public
class function Create() : TStopWatch;static;
class function StartNew() : TStopWatch;static;
class property Frequency : Int64 read FFrequency;
class property IsHighResolution : Boolean read FIsHighResolution;
procedure Reset();
procedure Start();
procedure Stop();
property ElapsedMilliseconds : Int64 read GetElapsedMilliseconds;
property ElapsedTicks : Int64 read GetElapsedTicks;
property IsRunning : Boolean read FRunning;
end;
resourcestring
sStopWatchNotInitialized = 'The StopWatch is not initialized.';
implementation
{$IFDEF WINDOWS}
uses
Windows;
{$ENDIF WINDOWS}
{ TStopWatch }
class function TStopWatch.Create(): TStopWatch;
{$IFDEF LINUX}
var
r : TBaseMesure;
{$ENDIF LINUX}
begin
if (FFrequency = 0) then begin
{$IFDEF WINDOWS}
FIsHighResolution := QueryPerformanceFrequency(FFrequency);
{$ENDIF WINDOWS}
{$IFDEF LINUX}
FIsHighResolution := (clock_getres(CLOCK_MONOTONIC,@r) = 0);
FIsHighResolution := FIsHighResolution and (r.tv_nsec <> 0);
if (r.tv_nsec <> 0) then
FFrequency := C_BILLION div r.tv_nsec;
{$ENDIF LINUX}
end;
FillChar(Result,SizeOf(Result),0);
end;
class function TStopWatch.StartNew() : TStopWatch;
begin
Result := TStopWatch.Create();
Result.Start();
end;
procedure TStopWatch.CheckInitialization();
begin
if (FFrequency = 0) then
raise Exception.Create(sStopWatchNotInitialized);
end;
function TStopWatch.GetElapsedMilliseconds: Int64;
begin
{$IFDEF WINDOWS}
Result := ElapsedTicks * TicksPerMilliSecond;
{$ENDIF WINDOWS}
{$IFDEF LINUX}
Result := FElapsed div C_MILLION;
{$ENDIF LINUX}
end;
function TStopWatch.GetElapsedTicks: Int64;
begin
CheckInitialization();
{$IFDEF WINDOWS}
Result := (FElapsed * TicksPerSecond) div FFrequency;
{$ENDIF WINDOWS}
{$IFDEF LINUX}
Result := FElapsed div TicksPerNanoSecond;
{$ENDIF LINUX}
end;
procedure TStopWatch.Reset();
begin
Stop();
FElapsed := 0;
FillChar(FStartPosition,SizeOf(FStartPosition),0);
end;
procedure TStopWatch.Start();
begin
if FRunning then
exit;
FRunning := True;
{$IFDEF WINDOWS}
QueryPerformanceCounter(FStartPosition);
{$ENDIF WINDOWS}
{$IFDEF LINUX}
clock_gettime(CLOCK_MONOTONIC,@FStartPosition);
{$ENDIF LINUX}
end;
procedure TStopWatch.Stop();
var
locEnd : TBaseMesure;
s, n : Int64;
begin
if not FRunning then
exit;
FRunning := False;
{$IFDEF WINDOWS}
QueryPerformanceCounter(locEnd);
FElapsed := FElapsed + (UInt64(locEnd) - UInt64(FStartPosition));
{$ENDIF WINDOWS}
{$IFDEF LINUX}
clock_gettime(CLOCK_MONOTONIC,@locEnd);
if (locEnd.tv_nsec < FStartPosition.tv_nsec) then begin
s := locEnd.tv_sec - FStartPosition.tv_sec - 1;
n := C_BILLION + locEnd.tv_nsec - FStartPosition.tv_nsec;
end else begin
s := locEnd.tv_sec - FStartPosition.tv_sec;
n := locEnd.tv_nsec - FStartPosition.tv_nsec;
end;
FElapsed := FElapsed + (s * C_BILLION) + n;
{$ENDIF LINUX}
end;
end.
+2
它在Windows上不起作用。在秒錶停止之前無法讀取經過的時間,並且結果值不顯示任何有用的值。 – Wosi
4
有從項目絕地看看TJclCounter。考慮到QueryPerformanceCounter調用開銷,它的實現比Delphi的TStopwatch更復雜。
相關問題
- 1. 什麼是C#相當於Delphi的FormatFloat?
- 2. Delphi/Free Pascal是否有免費的JMS客戶端?
- 3. Free Pascal中的文字數組的語法是什麼?
- 4. 什麼是Delphi Prism中的paramstr相當於
- 5. 什麼是Delphi相當於php中的「fsockopen」函數?
- 6. 什麼是BindingFlags.Default相當於?
- 7. 什麼是Delphi相當於C++參考參數?
- 8. Free Pascal和Delphi的單源單元測試
- 9. 的Free Pascal退出碼201
- 10. 什麼是FAR PASCAL?
- 11. Java相當於Delphi的DBCtrlGrid?
- 12. 什麼是Ruby相當於PHP的的=
- 13. Pascal中的^ I是什麼?
- 14. 相當於什麼?在正則表達式delphi中的MatchesMask?
- 15. dojo相當於$('body')的是什麼?
- 16. 什麼是WPF中的「OnIdle」相當於
- 17. 什麼是DBMS_OUTPUT的MySQL相當於
- 18. 什麼是Android中的OnInputListener相當於
- 19. 什麼是新的SDK相當於FB.Facebook.get_isInCanvas
- 20. 什麼是相當於on.event.remove的流
- 21. 什麼是jQuery相當於dojo的marginBox()?
- 22. 什麼是此SQL的HQL相當於
- 23. 什麼是iOS中的onDraw相當於
- 24. 什麼是GraphicsMagick相當於ImageMagick的Blend?
- 25. 什麼是.htaccess的nginx相當於
- 26. 相當於System.Windows.Forms.SendKeys的「鼠標」是什麼?
- 27. 什麼是C++相當於Java的StdIn.isEmpty()
- 28. 什麼是CakePHP相當於WordPress的header.php?
- 29. 什麼是相當於Python的foreach php
- 30. 什麼是gdb的 - lgb相當於--args?
根據您的需要,您可以通過在窗口中調用QueryPerformanceFrequency/QueryPerformanceCounter來獲得足夠的值。 – jachguate
當然,我可以爲QueryPerformanceXXX API編寫自己的包裝器,也許Free Pascal有自己的跨平臺解決方案。 – kludg
我不習慣freepascal。這個http://code.google.com/p/phocis/source/browse/trunk/lib/StopWatch.pas?r=34標有「Early beta:各種freepascal功能和」stuf「」 – bummi