Форум: "Начинающим";
Текущий архив: 2006.06.11;
Скачать: [xml.tar.bz2];

Вниз

Время выполнения процедуры   Найти похожие ветки 

← →
Std ©   (2006-05-26 23:17) [0]

Уважаемые мастера, подскажите как зделать таймер который бы щитал время выполнения процедуры, и выводил это время то тысячный(но лучшедо десятитысячных) секунды.
типа при нажатии кнопки выполняется чтото типа starttimer() в конце делается stoptime() и в какой то переменной было время выполения процедуры в СЕКУНДАХ

---

← →
Джо ©   (2006-05-26 23:34) [1]

function StartTimer(var Time1: Int64): Boolean;
begin
 Result := QueryPerformanceFrequency (Freq) ;
 QueryPerformanceCounter (Time1);
end;

function MeasureTimer (Time1: Int64): Extended;
var
 Time2: Int64;
begin
 QueryPerformanceCounter(Time2);
 Result := (Time2-Time1)/Freq
end;

procedure TForm23.Button1Click(Sender: TObject);
var
 ATime: Int64;
 ElapsedSec: Extended;
begin
 StartTimer(ATime);

 //
 Sleep (1000);
 //

 ElapsedSec := MeasureTimer(ATime);
 ShowMessageFmt ("Прошло: %.4f",[ElapsedSec])
end;


---

← →
Джо ©   (2006-05-26 23:35) [2]

забыл, в секции implementation объяви
var
 Freq: Int64;

---

← →
Джо ©   (2006-05-26 23:46) [3]

Не, так лучше буить :)

 ICounter = interface
   ["{D286E702-ED7E-45D1-8748-4F1D043ACEA6}"]
   procedure Start;
   function Elapsed: Double;
 end;

function CreateCounter: ICounter;

implementation

type
 TCounter = class (TInterfacedObject, ICounter)
 private
   FFreq,
   FTime1: Int64;
 public
   procedure Start;
   function Elapsed: Double;
   constructor Create;
 end;

function CreateCounter: ICounter;
begin
 Result := TCounter.Create
end;

constructor TCounter.Create;
begin
 if not QueryPerformanceFrequency (FFreq) then
   raise Exception.Create("Таймер аппаратно не поддерживается");
 Start
end;

function TCounter.Elapsed: Double;
var
 FTime2: Int64;
begin
 QueryPerformanceCounter (FTime2);
 Result := (FTime2-FTime1)/FFreq
end;

procedure TCounter.Start;
begin
 QueryPerformanceCounter (FTime1);
end;

end.


Используем:

procedure TForm23.Button1Click(Sender: TObject);
var
 Counter: ICounter;
begin
 Counter := CreateCounter;

 //
 Sleep(1000);
 //

 ShowMessageFmt ("%.4f",[Counter.Elapsed])
end;


---

← →
Std ©   (2006-05-26 23:51) [4]

огромное спасибо

---

← →
Std ©   (2006-05-27 00:02) [5]

а куда сунуть
ICounter = interface
  ["{D286E702-ED7E-45D1-8748-4F1D043ACEA6}"]
  procedure Start;
  function Elapsed: Double;
end;
а то на нем постоянно выскакивает [Pascal Error] Unit2.pas(12): E2029 "IMPLEMENTATION" expected but ";" found
куда б его не всунул все время эту хрень пишет
З.Ы. первый вариант без поблем работает :)

---

← →
Джо ©   (2006-05-27 00:06) [6]

> куда б его не всунул все время эту хрень пишет

Его не нужно никуда засовывать.:) Это объявление типа-интерфейса. Соответственно, перед ним нужно написать type.
Рекоммендую все это дело оформить отдельным юнитом.

---

← →
Std ©   (2006-05-27 00:18) [7]

вот зделал модуль

unit Unit2;
interface
uses Windows;
ICounter = interface
  ["{D286E702-ED7E-45D1-8748-4F1D043ACEA6}"]
  procedure Start;
  function Elapsed: Double;
end;
function CreateCounter: ICounter;
implementation
type
TCounter = class (TInterfacedObject, ICounter)
private
  FFreq,
  FTime1: Int64;
public
  procedure Start;
  function Elapsed: Double;
  constructor Create;
end;
function CreateCounter: ICounter;
begin
Result := TCounter.Create
end;
constructor TCounter.Create;
begin
if not QueryPerformanceFrequency (FFreq) then
  raise Exception.Create("Таймер аппаратно не поддерживается");
Start
end;

function TCounter.Elapsed: Double;
var
FTime2: Int64;
begin
QueryPerformanceCounter (FTime2);
Result := (FTime2-FTime1)/FFreq
end;
procedure TCounter.Start;
begin
QueryPerformanceCounter (FTime1);
end;
end.


и всеравно пишет туже хрень :)

---

← →
Джо ©   (2006-05-27 00:19) [8]

> и всеравно пишет туже хрень :)

Ты ведь и сделал "ту же хрень". Type кто писать будет, а?

---

← →
Std ©   (2006-05-27 00:26) [9]

мда, пратупил, извиняюсь

кстати вопрос уже немного не по теме

Counter := CreateCounter;
Sleep(5000);
ShowMessageFmt ("%.4f",[Counter.Elapsed])

выводит 4,9994 а по идее ж должен 5 вывести. сч ем это связано?

---

← →
Джо ©   (2006-05-27 00:28) [10]

> выводит 4,9994 а по идее ж должен 5 вывести. сч ем это связано?

С тем, что Windows не real-time ОС. С тем, что мерять "десятитысячные" доли секунды это, собственно, абсурдно. Много с чем связано.

---

← →
Rial ©   (2006-05-27 01:09) [11]

Кстати, с неверным укруглением тоже может быть связано.

Посмотри вот это на досуге:

function GetCpuSpeed(Const CPUTestTime:Integer):Extended;
Var TimerHi,TimerLo:DWord;
   PriorityClass,Priority:Integer;
   Process,Thread:THandle;
begin
Process:=GetCurrentProcess;
Thread:=GetCurrentThread;
PriorityClass:=GetPriorityClass(Process);
Priority:=GetThreadPriority(Thread);
SetPriorityClass(Process,REALTIME_PRIORITY_CLASS);
SetThreadPriority(Thread,THREAD_PRIORITY_TIME_CRITICAL);
Sleep(50);
Asm
 DW 310Fh
 Mov TimerLo,EAx
 Mov TimerHi,EDx
End;
Sleep(CPUTestTime);
Asm
 DW 310Fh
 Sub EAx,TimerLo
 Sbb EDx,TimerHi
 Mov TimerLo,EAx
 Mov TimerHi,EDx
end;
SetThreadPriority(Thread,Priority);
SetPriorityClass(Process,PriorityClass);
GetCpuSpeed:=TimerLo/(MHzMulti*CPUTestTime);
end;

---

Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.06.11;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.011 c