Автор: http://www.swissdelphicenter.ch

procedure Delay(Milliseconds: Integer);
 {by Hagen Reddmann}
 var
   Tick: DWord;
   Event: THandle;
 begin
   Event := CreateEvent(nil, False, False, nil);
   try
     Tick := GetTickCount + DWord(Milliseconds);
     while (Milliseconds > 0) and
           (MsgWaitForMultipleObjects(1, Event, False, Milliseconds, QS_ALLINPUT) <> WAIT_TIMEOUT) do
     begin
       Application.ProcessMessages;
       Milliseconds := Tick - GetTickcount;
     end;
   finally
     CloseHandle(Event);
   end;
 end;