Модератор: Модераторы
Отвечаю - GetTickCount ) Модуль LCLIntf
uses BaseUnix, Unix;
function GetTickCount: Cardinal; stdcall;
var
t: timeval;
begin
fpgettimeofday(@t, nil);
result := t.tv_sec * 1000 + t.tv_usec div 1000;
end;
unit PerformanceTime;
{ =============================================================================
Модуль PerformanceTime содержит описание класса TPerformanceTime, который
позволяет измерить время выполнения куска кода. Необходимо инициализировать
переменную типа TPerformanceTime, выполнить метод Start. проделать работу (код)
Выполнить метод Stop, после чего в св-ве Delay будет время выполнения кода
в секундах.
Пример:
T:=TPerformanceTime.Create;
T.Start;
Sleep(1000);
T.Stop;
Caption:=FloatToStr(T.Delay);//покажет время равное 1 секунде +/- погрешность
Так же в классе есть учет погрешности за счет вызова внутренних процедур класса.
За это отвечает параметр в конструкторе. если он True то будет учет погрешности
(задержка самого таймера, за счет вызова процедур)
Примечание: Позволяет измерять время выполнения кода. Если код "быстрый" можно
использовать for I:=1 to N do (Код), после чего полученное время разделить
на N, При этом чем выше N тем меньше будет дисперсия.
Чем выше частота процессора, то по идее точность должна быть выше, по крайней
мере в Windows.
Среда разработки: Lazarus v0.9.29 beta и выше
Компилятор: FPC v 2.4.1 и выше
Автор: Maxizar
Дата создания: 03.03.2010
Дата редактирования: 12.01.2011
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
{$IFDEF windows}
Windows;
{$ENDIF}
{$IFDEF UNIX}
Unix, BaseUnix;
{$ENDIF}
Type
TPerformanceTime=class
private
FDelay :Real; //измеренное время в секундах
TimerDelay:Real; //Задержка (время) самого вычисления в секундах
StartTime :Real; //Время начала теста в секундах
public
constructor Create(EnabledTimerDelay:Boolean=True);
property Delay:Real read FDelay;
procedure Start;
procedure Stop;
end;
Function GetTimeInSec:Real; //вернет время в секундах, с начало работы ОС
implementation
function GetTimeInSec: Real;
var
{$IFDEF windows}
StartCount, Freq: Int64;
{$ENDIF}
{$IFDEF UNIX}
TimeLinux:timeval;
{$ENDIF}
begin
{$IFDEF windows}
if QueryPerformanceCounter(StartCount) then //возвращает текущее значение счетчика
begin
QueryPerformanceFrequency(Freq); //Кол-во тиков в секунду
Result:=StartCount/Freq; //Результат в секундах
end
else
Result:=GetTickCount*1000; //*1000, т.к GetTickCount вернет милиСекунды
{$ENDIF}
{$IFDEF UNIX}
fpGetTimeOfDay(@TimeLinux,nil);
Result:=TimeLinux.tv_sec + TimeLinux.tv_usec/1000000;
{$ENDIF}
end;
{ TPerformanceTime }
//------------------------------------------------------------------//
constructor TPerformanceTime.Create(EnabledTimerDelay: Boolean);
var TempTime,TempValue:Real;
begin
TimerDelay:=0;
if EnabledTimerDelay then
begin
TempValue :=GetTimeInSec; //Первый раз холостой, чтобы подгрузить нужные системные dll
//Но за одно и записали в TempValue число.
TempTime :=GetTimeInSec; //Теперь уже за правду записали время.
TempValue :=TempValue-GetTimeInSec-TempTime; //Тут пытаемся сделать работу подобной проц Stop
TimerDelay:=GetTimeInSec-TempTime; //подсчитали потери (погрешность) самого таймера (по идее проц Stop)
end;
end;
//------------------------------------------------------------------//
procedure TPerformanceTime.Start;
begin
StartTime:=GetTimeInSec;
end;
//------------------------------------------------------------------//
procedure TPerformanceTime.Stop;
begin
FDelay:=GetTimeInSec-StartTime-TimerDelay;
end;
end.
Interval := 1;
for i := 1 to 100000 do ListBox1.Items.Append(inttostr(GetTickCount));
...
7040033
7040033
7040033
7040033
7040043
7040043
7040043
...
function GetTickCounts: Int64;
var
diver: Currency;
begin
QueryPerformanceFrequency(Result);
diver:= Result / 1000;
QueryPerformanceCounter(Result);
diver := Result / diver;
Result := trunc(diver);
end;
VirtUX писал(а):function GetTickCounts: Int64;
var
diver: Currency;
begin
QueryPerformanceFrequency(Result);
diver:= Result / 1000;
QueryPerformanceCounter(Result);
diver := Result / diver;
Result := trunc(diver);
end;
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 11