Поясните за таймер!) Или таймер на формах наследниках

unit udPause;
 
{$R *.dfm}
 
interface
 
{$REGION 'uses'}
uses
  //============================== Модули проекта ==============================
  uHRTimer, uGlobalTypes,
  //========================= Модули проекта с формами =========================
  //=============================== Левые модули ===============================
  //=================== Системные модули, добавленные вручную ==================
  //=================== Модули, добавленные IDE автоматически ==================
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls,
  JvExControls, JvLabel, JvStaticText, Vcl.ComCtrls,
  JvExComCtrls, rkVistaProBar;
{$ENDREGION 'uses'}
 
{$REGION 'type TPauseThread = class(TThread)'}
type
  TPauseThread = class(TThread)
  private
    FTimer: THRTimer;
    FInterval: DWORD;
    FProgress: int32;
    FRemained: int32;
    FElapsed: DWORD;
    FPassCount: int64; // кол-во проходов (для отладки)
    FOnProgress: TNotifyEvent;
  protected
    procedure CallProgress; // синхронно !!!
    procedure Execute; override;
  public
    constructor Create(AInterval: DWORD); reintroduce;
    destructor Destroy; override;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    property Progress: int32 read FProgress;
    property Remained: int32 read FRemained; // сколько мс осталось
    property Elapsed: DWORD read FElapsed; // сколько мс прошло
    property PassCount: int64 read FPassCount; // кол-во проходов цикла ожидания
  end;
{$ENDREGION}
 
{$REGION 'type TPauseDlg = class(TForm)'}
type
  TPauseDlg = class(TForm)
    PanelClient: TPanel;
    PanelBottom: TPanel;
    ButtonAbort: TButton;
    PanelTimeRemain: TPanel;
    LabelBottomLeft: TLabel;
    LabelClock: TJvLabel;
    LabelCaption: TLabel;
    ShapeTimeRemain: TShape;
    ProgressBar: TVistaProBar;
    procedure ButtonAbortClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    FThread: TPauseThread;
    procedure Abort;
    procedure ThreadProgress(Sender: TObject);
    procedure ThreadTerminate(Sender: TObject);
  protected
    function GetPassCount: int64;
  public
    function ShowModal(AInterval: DWORD; const ATitle: string = ''): int32; reintroduce;
    property TotalPassCount: int64 read GetPassCount;
  end;
{$ENDREGION}
 
var
  DialogPause: TPauseDlg;
 
const
  // если интервал не превышает SLEEP_MAX_INTERVAL - 1, то окно не показывается,
  // а вызывается тупой Sleep(AInterval)
  SLEEP_MAX_INTERVAL = 200.1; // todo: сделать настраиваемым!!!
 
//function ShowPause(const AInterval: DWORD; const ATitle: string = ''): TModalResult; overload;
function ShowPauseDialog(data: TCustomDialogData): TModalResult; //overload
 
implementation
 
{$REGION 'uses'}
uses
  //============================== Модули проекта ==============================
  uRoutines,
  //========================= Модули проекта с формами =========================
  umGlobals;
  //=============================== Левые модули ===============================
  //=================== Системные модули, добавленные вручную ==================
{$ENDREGION 'uses'}
 
{$REGION 'service'}
function ShowPauseDialog(data: TCustomDialogData): TModalResult;
var
  dlg_data: TPauseDialogData absolute data;
begin
  assert(assigned(data));// мало ли...
 
  // при короткой паузе диалог не показывается,
  // т.к. юзер не успеет жмакнуть отмену.
  if dlg_data.Interval < SLEEP_MAX_INTERVAL
    then begin
            Sleep(round(dlg_data.Interval));
            Result:= mrOK;
         end
    else begin
           // диалог создаётся один раз и висит в памяти до завершения программы.
           if not Assigned(DialogPause)
             then DialogPause:= TPauseDlg.Create(Application);
           Result:= DialogPause.ShowModal(round(dlg_data.Interval));
         end;
 
  dlg_data.DialogResult:= result; // передача результата наружу
end;
 
 
{$ENDREGION}
 
{$REGION 'TPauseThread'}
{ TPauseThread }
 
procedure TPauseThread.CallProgress;
begin
  if Assigned(FOnProgress)
    then FOnProgress(Self);
end;
 
constructor TPauseThread.Create(AInterval: DWORD);
begin
  inherited Create(true);
  FInterval:= AInterval;
  FTimer:= THRTimer.Create();
  FreeOnTerminate:= true;
end;
 
destructor TPauseThread.Destroy;
begin
  FTimer.Free();
  inherited;
end;
 
procedure TPauseThread.Execute;
var
  old_progress: int32;
begin
  inherited;
  if not FTimer.StartTimer()
    then raise Exception.CreateFmt('FATAL ERROR. Не удалось запустить TPauseThread на интервале %u.', [FInterval]);
 
  FRemained:=       FInterval;
  ReturnValue:=     mrOk; // по умолчанию
  FPassCount:=      0;
  FProgress:=       0;
  old_progress:=    0;
  Synchronize(CallProgress);
 
  repeat
    FElapsed:= trunc(FTimer.ReadTimer()); // прошло с начала задержки
 
    if Terminated
      then begin
             ReturnValue:= mrAbort; // отменено юзером
             break;
           end;
 
    Yield(); // YieldProcessor();
    sleep(1);
 
    inc(FPassCount);
    FRemained:= FInterval - FElapsed; // осталось до конца задержки
    FProgress:= round(100.0 * FElapsed / FInterval);
    if FProgress <> old_progress
      then begin
             old_progress:= FProgress;
             Synchronize(CallProgress);
           end;
  until FRemained < 1; // <= 0
end;
{$ENDREGION}
 
{$REGION 'TPauseDlg'}
{ TPauseDlg }
 
procedure TPauseDlg.Abort;
begin
  FThread.Terminate();
  Application.ProcessMessages();
end;
 
procedure TPauseDlg.ButtonAbortClick(Sender: TObject);
begin
  Abort();
end;
 
procedure TPauseDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caHide; // эта форма всегда болтается в памяти после создания
end;
 
procedure TPauseDlg.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13  // отмена по ESC
    then Abort();
end;
 
function TPauseDlg.GetPassCount: int64;
begin
  if Assigned(FThread)
    then Result:= FThread.PassCount
    else Result:= -1;
end;
 
function TPauseDlg.ShowModal(AInterval: DWORD; const ATitle: string = ''): int32;
begin
  ShowHint:= Application.ShowHint;
  KeyPreview:= true; // ловить Escape
 
  LabelCaption.Caption:= 'Ожидание ' + FloatToStrF(AInterval / 1000.0, ffGeneral, 7, 3) + ' сек'; // MillisecondsToStrNH(AInterval);
 
  // цвета прогресса в зависимоти от темы
  if CustomThemeActive
    then begin
           ProgressBar.Color:= clThemeButtonHot;
           ProgressBar.BackColor:= clThemePanel;
           ProgressBar.BorderColor:= clThemeBorder;
         end
    else begin
           ProgressBar.Color:= clLime;
           ProgressBar.BackColor:= clBtnFace;
           ProgressBar.BorderColor:= clSilver;
         end;
  ProgressBar.CornerColor:= ProgressBar.BorderColor;
 
  // подготовка и старт треда
  FThread:= TPauseThread.Create(AInterval);
  FThread.OnProgress:= ThreadProgress;
  FThread.OnTerminate:= ThreadTerminate;
  FThread.Start();
  result:= inherited ShowModal();
end;
 
procedure TPauseDlg.ThreadProgress(Sender: TObject);
var
  tt: TPauseThread absolute Sender;
begin
  ProgressBar.Position:=   tt.Progress;
  LabelClock.Caption:= MillisecondsToStrNH(Double(tt.Remained));//  Format('%d ', [tt.Remained]);
end;
 
procedure TPauseDlg.ThreadTerminate(Sender: TObject);
var
  tt: TPauseThread absolute Sender;
begin
  ModalResult:= tt.ReturnValue;
end;
 
{$ENDREGION}
 
 
end.

unit uHRTimer;
 
interface
 
{$REGION 'uses'}
uses
  //============================== Модули проекта ==============================
  //=============================== Левые модули ===============================
  //=================== Системные модули, добавленные вручную ==================
  Windows, SysUtils, Math;
{$ENDREGION 'uses'}
 
{$REGION 'type THRTimer = class'}
type
  // --------------------- Класс - высокоточный таймер -------------------------
  THRTimer = class
  private
    StartTime: Double;
    ClockRate: Double;
    FSleepIterations: uint64;
  public
    Exists: Boolean;    // Флаг успешного создания таймера
 
    constructor Create;
    function StartTimer: Boolean; // Обнуление таймера
    function ReadTimer: Double;   // Чтение значения таймера в миллисекундах
    function ReadTimerStr: string; // Чтение таймера (возвращает строку для показа)
 
    procedure Freeze(Interval: Double); // жёсткая задержка в цикле (интервал - в миллисекундах)
    property SleepIterations: uint64 read FSleepIterations;
  end;
{$ENDREGION}
 
{$REGION 'service prototypes'}
function MillisecondsToStr(const tms: Double): string;
function MillisecondsToStrNH(const tms: Double): string; // показывает час, только если кол-во часов <> 0
function MillisecondsToStrEx(const tms: Double): string;
function SecondsToStrEx(const seconds: Double): string;
{$ENDREGION}
 
implementation
 
{$REGION 'service'}
function MillisecondsToStr(const tms: Double): string;
var
  T: DWORD;
  mS, S, M, H: Word;
begin
  T:= Trunc(tms / 1000); // целое в секундах
  ms:= Trunc(tms) mod 1000; // дробный остаток 0...1 сек
  H:= T div 3600;          // кол-во часов
  M:= (T mod 3600) div 60; // минута в часе
  S:= T mod 60;            // секунды в минуте
 
  Result:= Format('%d:%.2d:%.2d,%.3d', [H, M, S, mS]);
end;
 
function MillisecondsToStrNH(const tms: Double): string;
var
  T: DWORD;
  mS, S, M, H: Word;
begin
  // показывает час, только если кол-во часов <> 0
  T:= Trunc(tms / 1000); // целое в секундах
  ms:= Trunc(tms) mod 1000; // дробный остаток 0...1 сек
  H:= T div 3600;          // кол-во часов
  M:= (T mod 3600) div 60; // минута в часе
  S:= T mod 60;            // секунды в минуте
 
  if H = 0
    then Result:= Format('%d:%.2d,%.3d', [M, S, mS])
    else Result:= Format('%d:%.2d:%.2d,%.3d', [H, M, S, mS]);
end;
 
function MillisecondsToStrEx(const tms: Double): string;
begin
  if tms < 1.0
    then Exit(Format('%d мкс', [Trunc(tms * 1000)]));
 
  if tms < 1000.0
    then Exit(Format('%g мс', [RoundTo(tms, -3)])); //Format('%.3f мс', [tms])
 
  if tms < 60000.0
    then Exit(Format('%g сек', [tms / 1000]));
 
  Result:= MillisecondsToStr(tms);
end;
 
function SecondsToStrEx(const seconds: Double): string;
begin
  result:= MillisecondsToStrEx(1000.0 * seconds);
end;
{$ENDREGION}
 
{$REGION 'THRTimer'}
{ THRTimer }
 
constructor THRTimer.Create;
var
  QW: LARGE_INTEGER;
begin
  inherited Create;
  Exists := QueryPerformanceFrequency(Int64(QW));
  ClockRate := QW.QuadPart;
end;
 
procedure THRTimer.Freeze(Interval: Double);
begin
  // жёсткая задержка в цикле. (интервал - в миллисекундах)
  // Использовать только на ультракоротких интервалах (микросекунды)!
  FSleepIterations:= 0;
  StartTimer();
  repeat
    inc(FSleepIterations);
  until ReadTimer() > Interval;
end;
 
function THRTimer.StartTimer: Boolean;
var
  QW: LARGE_INTEGER;
begin
  Result := QueryPerformanceCounter(Int64(QW));
  StartTime := QW.QuadPart;
end;
 
function THRTimer.ReadTimer: Double;
var
  ET: LARGE_INTEGER;
begin
  QueryPerformanceCounter(Int64(ET));
  Result := 1000.0 * (ET.QuadPart - StartTime) / ClockRate;
end;
 
function THRTimer.ReadTimerStr: string;
var
  T: Double; // время в миллисекундах
begin
  T:= Self.ReadTimer();
 
  if T < 1000.0
    then Result:= Format('%.3f мс', [T])
    else Result:= MillisecondsToStr(T);
end;
{$ENDREGION}
 
end.