unit WaitDelay;
interface
uses
  Windows, SysUtils, Forms;
type
  TConditionMethod = function: boolean of object;
  TCondition = function: boolean;
function Wait(const TimeOut: word; const Condition: TConditionMethod): boolean;
  overload;
function Wait(const TimeOut: word; const Condition: TCondition): boolean;
  overload;
// Waits for TimeOut/100 sec. or condition = true
procedure Wait(const TimeOut: word); overload;
// Waits for TimeOut/100 sec.
procedure NonBlockingDelay(Time: Cardinal); // Waits for <Time> msecs in 1 msecs resolution
procedure Delay(Time: Cardinal);  // Waits for Time <msecs> in 1 msecs resolution

implementation
procedure NonBlockingDelay(Time: Cardinal);
const
  HandleCount = 1;
var
  TimerID: Cardinal;
  TimeToWait: Int64;
  DoneWaiting: Boolean;
  Handles    : array[0..HandleCount - 1] of THandle;
begin
  if timeBeginPeriod(1) <> TIMERR_NOERROR then
    RaiseLastOSError;
  try
    Handles[0] := CreateEvent(nil, True, False, nil);
    if Handles[0] = 0 then
      RaiseLastOSError;
    try
      TimerID:= timeSetEvent(Time, 1, TFNTimeCallBack(Handles[0]), 0, TIME_ONESHOT or TIME_CALLBACK_EVENT_SET);
      if TimerID = 0 then
        RaiseLastOSError;
      try
        DoneWaiting := False;
        repeat
          case MsgWaitForMultipleObjects(HandleCount, Handles, False, Infinite, QS_ALLEVENTS) of
            WAIT_OBJECT_0:
              DoneWaiting := True;
            WAIT_OBJECT_0 + HandleCount:
              Application.ProcessMessages;
            end;
        until DoneWaiting;
      finally
        timeKillEvent(TimerID);
        end;
    finally
      CloseHandle(Handles[0]);
      end;
  finally
    timeEndPeriod(1);
    end;
end;
procedure Delay(Time: Cardinal);
var
  TimerID: Cardinal;
  TimeToWait: Int64;
  DoneWaiting: Boolean;
  EventHandle: THandle;
begin
  if timeBeginPeriod(1) <> TIMERR_NOERROR then
    RaiseLastOSError;
  try
    EventHandle := CreateEvent(nil, True, False, nil);
    if EventHandle = 0 then
      RaiseLastOSError;
    try
      TimerID:= timeSetEvent(Time, 1, TFNTimeCallBack(EventHandle), 0, TIME_ONESHOT or TIME_CALLBACK_EVENT_SET);
      if TimerID = 0 then
        RaiseLastOSError;
      try
        WaitForSingleObject(EventHandle, Infinite);
      finally
        timeKillEvent(TimerID);
        end;
    finally
      CloseHandle(EventHandle);
      end;
  finally
    timeEndPeriod(1);
    end;
end;
function Wait(const TimeOut: word; const Condition: TConditionMethod): boolean;
var
  EndTime: TDateTime;
  Msg: TMsg;
begin
  EndTime := Now + (TimeOut/SecsPerDay/1000);
  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
    Result := Condition;
  until (Now > EndTime) or Result;
end;
function Wait(const TimeOut: word; const Condition: TCondition): boolean;
var
  EndTime: TDateTime;
  Msg: TMsg;
begin
  EndTime := Now + (TimeOut/SecsPerDay/1000);
  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
    Result := Condition;
  until (Now > EndTime) or Result;
end;
procedure Wait(const TimeOut: word);
var
  EndTime: TDateTime;
  Msg: TMsg;
begin
  EndTime := Now + (TimeOut/SecsPerDay/1000);
  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  until Now > EndTime;
end;
end.