Листинг 1

unit timer18;
interface

function Clock : longint;
        {время, прошедшее с запуска программы в 1/18 с}
procedure ResetTime; {сброс всех показаний времени в 0}
function GetFPS : single;
                  {текущее число кадров в секунду}
             {необходимо вызывать 1 раз в каждом кадре}
implementation

var
   ZeroClock    : longint;    {время запуска программы}
   LastFPSclock : longint; {-»- последнего запроса FPS}
   Days         : longint;                  {номер дня}
   LastClock    : longint;  {время предыдущего запроса}
   NumberFrames : integer;             {счетчик кадров}
   FPS          : single; {число кадров в секунду}

function Clock : longint;
        {время, прошедшее с запуска программы в 1/18 с}
var t : longint;
begin
   t := meml[Seg0040:$6c] - ZeroClock;
   if t < LastClock then begin {переход на след. сутки}
      inc(Days);
   end;
   LastClock := t;
   Clock := t + days*1573040;       {1 сутки - 1573040}
end;
procedure ResetTime; {сброс всех показаний времени в 0}
begin
   ZeroClock := meml[Seg0040:$6c];
   LastFPSclock := 0;
   NumberFrames := 0;
   FPS := 0;
   Days := 0;
   LastClock := 0;
end;

function GetFPS : single;
{текущее число кадров в секунду}
var
   c : longint;
   e : single;
begin
   inc(NumberFrames);
   c := Clock;
   if (c - LastFPSclock) >= 18 then begin
             {интервал времени измерения не меньше 1 с}
      FPS := NumberFrames / (c - LastFPSclock) * 18.2;
      NumberFrames := 0;
      LastFPSclock := c;
   end;
   GetFPS := FPS;
end;

begin
   ResetTime;
end.