procedure Delay(Milliseconds: Integer);
var
Unicode: Boolean;
Event: THandle;
Tick: DWORD;
Msg: TMsg;
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
if PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
then begin
Unicode := (Msg.hwnd = 0)
or IsWindowUnicode(Msg.hwnd);
if (
not Unicode and PeekMessageA(Msg, 0, 0, 0, PM_REMOVE))
or (
Unicode and PeekMessageW(Msg, 0, 0, 0, PM_REMOVE))
then begin
if Msg.
message = WM_QUIT
then begin
PostQuitMessage(Msg.wParam);
Break;
end;
TranslateMessage(Msg);
if Unicode then DispatchMessageW(Msg)
else DispatchMessageA(Msg);
end;
Milliseconds := Integer(Tick - GetTickcount);
end;
end;
finally
CloseHandle(Event);
end;
end;