procedure WaitPlease(Milliseconds: integer);
var Frequency, EndTime, CurrentTime, WaitTime: Int64;
begin
  QueryPerformanceFrequency(Frequency);
  WaitTime := Trunc((Frequency / 1000) * Milliseconds);
  QueryPerformanceCounter(EndTime);
  EndTime := EndTime + WaitTime;
  repeat
    QueryPerformanceCounter(CurrentTime)
  until (CurrentTime >= EndTime)
end;

unit TimeDelayManager;

interface

uses Windows, Forms, Classes;

type
  TTimeDelayManager = class;

  TTimerThread = class(TThread)
  private
    FOwner: TTimeDelayManager;
  protected
    procedure DoUserEvent;
  public
    constructor Create(CreateSuspended: Boolean; AOwner: TTimeDelayManager);
  protected
    procedure Execute; override;
  end;

  TTimeDelayManager = class(TComponent)
  private
    FHardTime: Boolean;
    FDelay: LongWord;
    FTimerThread: TTimerThread;
    FOnTimer: TNotifyEvent;
    procedure WaitPlease;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Start;
    procedure StartAsThread;
  published
    property Delay: LongWord read FDelay write FDelay;
    property HardTime: Boolean read FHardTime write FHardTime;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TTimeDelayManager]);
end;

{ TTimeDelayManager }

constructor TTimeDelayManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDelay := 1000;
  FHardTime := False;
end;

procedure TTimeDelayManager.WaitPlease;
var
  Frequency, EndTime, CurrentTime, WaitTime: Int64;
begin
  QueryPerformanceFrequency(Frequency);
  WaitTime := Trunc((Frequency / 1000) * FDelay);
  QueryPerformanceCounter(EndTime);
  EndTime := EndTime + WaitTime;
  repeat
    if not FHardTime then
      Application.ProcessMessages;
    QueryPerformanceCounter(CurrentTime)
  until (CurrentTime >= EndTime);
end;

procedure TTimeDelayManager.Start;
begin
  WaitPlease;
  if Assigned(FOnTimer) then
    FOnTimer(Self);
end;

procedure TTimeDelayManager.StartAsThread;
begin
  TTimerThread.Create(False, Self);
end;

{ TTimerThread }

constructor TTimerThread.Create(CreateSuspended: Boolean; AOwner: TTimeDelayManager);
begin
  inherited Create(CreateSuspended);
  FOwner := AOwner;
end;

procedure TTimerThread.Execute;
begin
  FOwner.WaitPlease;
  Synchronize(DoUserEvent);
end;

procedure TTimerThread.DoUserEvent;
begin
  if Assigned(FOwner.FOnTimer) then
    FOwner.FOnTimer(FOwner);
end;

end.