Der Vorschlag in #5 ist unbrauchbar - da kann man die CPU als Heizung benutzen.
Die Funktion
MsgWaitForMultipleObjects ist die Lösung:
Delphi-Quellcode:
function GetTickCount64: Int64; // vermeidet das 49.7-Tage-Problem
var
QFreq, QCount: Int64;
begin
Result := GetTickCount;
if QueryPerformanceFrequency(QFreq) then
begin
QueryPerformanceCounter(QCount);
if QFreq <> 0 then
Result := (QCount div QFreq) * 1000;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Tick, ms: Int64;
Event: THandle;
Label go;
begin
go:
ms:=1000; //millisec
Event := CreateEvent(nil, False, False, nil);
try
Tick := GetTickcount64 + ms;
while (ms > 0) and
(MsgWaitForMultipleObjects(1, Event, False, ms, QS_ALLINPUT) <> WAIT_TIMEOUT) do
begin
if Application.Terminated then Exit;
ms := Tick - GetTickcount64;
Application.ProcessMessages;
end;
finally
CloseHandle(Event);
end;
Label1.Caption:= TimeToStr(now);
//Uhr zeichnen
Goto go;
end;