Код: Выделить всё
{ Имя файла: HRTimer.PAS V1.00
Создан: Апр 17 1997, 06:40, автор John Mertus
Обновлен #6: Окт 12 1997, 10:56 John Mertus
Оболочка для таймера высокой точности при создании приложений под Win95/WinNT
пример использования:
Var
HRT : THRTimer
HRT := THRTimer.Create;
HRT.StartTimer; Сброс таймера в ноль
HRT.ReadTimer; Возвращает отсчитанное время в миллисекундах начиная со времени старта
HRT.Free; }
{-----------------Модуль HRTimer-------------------John Mertus Апрель 97---}
Unit HRTimer;
{-------------------Объявления-------------------------------}
interface
Uses Windows;
Type
THRTimer = Class(TObject)
Constructor Create;
destructor Destroy; override;
Function StartTimer : Boolean;
Function ReadTimer : Double;
procedure Wait(mks: integer);
private
StartTime : int64;
ClockRate : int64;
public
Exists : Boolean;
End;
{--------------------------Реализация-----------------------------------}
implementation
{------------------Create-------------------------John Mertus----Мар 97-}
Constructor THRTimer.Create;
{ Получаем точное системное время и сохраняем его для дальнейшего использования.}
BEGIN
Inherited Create;
QueryPerformanceFrequency(ClockRate);
END;
{------------------StartTimer---------------------John Mertus----Мар 97-}
Function THRTimer.StartTimer : Boolean;
{ Получаем точное системное время и сохраняем его для дальнейшего использования.}
BEGIN
Result := QueryPerformanceCounter(StartTime);
END;
procedure THRTimer.Wait(mks: integer);
var
Counter, Freq, WaitUntil: Int64;
begin
if QueryPerformanceCounter(Counter) then
begin
QueryPerformanceFrequency(Freq);
WaitUntil := Counter {+ WaitCal} + (mks * (Freq div 1000000));
while Counter < WaitUntil do
QueryPerformanceCounter(Counter);
end
else
Sleep(mks div 1000);
end;
{-------------------ReadTimer---------------------John Mertus----Мар 97---}
destructor THRTimer.Destroy;
begin
inherited;
end;
Function THRTimer.ReadTimer : Double;
Var
ET : TLargeInteger;
BEGIN
QueryPerformanceCounter(ET);
Result := 1000000.0*(ET - StartTime)/ClockRate;
END;
end.