1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure MySleep(aMSecDelay: integer);
var
  i, c: integer;
  Event: THandle;
begin
  c:=0;
  Event := CreateEvent(nil, False, False, nil);
  RemCount:=aMSecDelay;
  From1.Label2.Caption:=SecToDMS(RemCount div 1000);
  for i:=1 to aMSecDelay do
  begin
    Application.ProcessMessages;
    if DoAbort then break; // DoAbort = Globale Variable
    Dec(RemCount);
    Inc(TimeCount);
    Inc(c);
    WaitForSingleObject(Event, 1);
    //Sleep(1); // auch schon mit Sleep versucht
    if (c > 999) then // Update nur jede sekunde
    begin
      Form1.Label1.Caption:=SecToDMS(TimeCount div 1000);
      From1.Label2.Caption:=SecToDMS(RemCount div 1000);
      c:=0;
    end;
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

procedure MySleep(aSecDelay: integer);
var
  i: integer;
  Event: THandle;
  RemCount: integer;
begin
  Event := CreateEvent(nil, False, False, nil);
  RemCount:=aSecDelay;
  From1.Label2.Caption:=SecToDMS(RemCount);
  for i:=1 to aSecDelay do
  begin
    Application.ProcessMessages;
    if DoAbort then break; // DoAbort = Globale Variable
    Dec(RemCount);
    Inc(TimeCount); // TimeCount wird bei FormCreate auf 0 gesetzt, soll also gesamtzeit übergeben
    WaitForSingleObject(Event, 1000);

    // Update der Labels
    Form1.Label1.Caption:=SecToDMS(TimeCount);
    From1.Label2.Caption:=SecToDMS(RemCount);
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

procedure TForm1.Button1Click(Sender: TObject);
var a, b, c: Int64; r: real; i: Integer;
begin
For i:=0 to 20 do
BEGIN
  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  Sleep(i);
  QueryPerformanceCounter(c);
  r:= (c - b) * 1000 / a;
  Memo1.lines.add('Sleep('+IntToStr(i)+') = '+ FloatToStrF(r, ffFixed, 12, 5)+' msec');
  Application.ProcessMessages;
END;
end;