Sleep without Freeze

Damit ein Programm nicht komplett einfriert, wen man den Sleep Befehl anwendet.

Der Sleep Befehl wird ausgeführt, aber das Programm lässt sich weiter steuern. 

procedure SleepWithoutFreeze(msec: int64);
var
  Start, Elapsed: DWORD;
begin
  Start := GetTickCount;
  Elapsed := 0;
  repeat
    // (WAIT_OBJECT_0+nCount) is returned when a message is in the queue.
    // WAIT_TIMEOUT is returned when the timeout elapses.
    if MsgWaitForMultipleObjects(0, Pointer(nil)^, FALSE, msec-Elapsed, QS_ALLINPUT) <> WAIT_OBJECT_0 then Break;
    Application.ProcessMessages;
    Elapsed := GetTickCount - Start;
  until Elapsed >= msec;
end;

Beispiel :

procedure TForm1.Button1Click(Sender: TObject);
begin
  SleepWithoutFreeze(5000);  // 5 sec.
end;