Alternative Sleep Methods

procedure Delay(dwMilliseconds: Longint);

var

  iStart, iStop: DWORD;

begin

  iStart := GetTickCount;

  repeat

    iStop := GetTickCount;

    Application.ProcessMessages;

    Sleep(1); // addition from Christian Scheffler to avoid high CPU last

  until (iStop - iStart) >= dwMilliseconds;

end;

procedure Delay(msecs: Longint);

var

  targettime: Longint;

  Msg: TMsg;

begin

  targettime := GetTickCount + msecs;

  while targettime > GetTickCount do

    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then

    begin

      if Msg.message = WM_QUIT then

      begin

        PostQuitMessage(Msg.wParam);

        Break;

      end;

      TranslateMessage(Msg);

      DispatchMessage(Msg);

    end;

end;

{

  Note:

  The elapsed time is stored as a DWORD value.

  Therefore, the time will wrap around to zero if the system is

  run continuously for 49.7 days.

}

Sleep(dwMilliseconds: Word);

procedure PauseFunc(delay: DWORD);

var

  lTicks: DWORD;

begin

  lTicks := GetTickCount + delay;

  repeat

    Sleep(100);

    Application.ProcessMessages;

  until (lTicks <= GetTickCount) or Application.Terminated;

end;

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;