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

procedure TForm2.Button2Click(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;					

1:
2:
3:
4:
5:
6:
7:
8:

var
  a, b,  d: Int64;
begin
  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  repeat
  QueryPerformanceCounter(d);
  until  ((d-b)*1000000/a)  > 100 ; //100 µs					

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:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;


implementation

{$R *.dfm}

procedure MM(s:string); begin Form2.Memo1.Lines.Add(s); end;

procedure TMyThread.Execute;
var
  a, b,  d: Int64;
begin
  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  repeat
  QueryPerformanceCounter(d);
  until  ((d-b)*1000000/a)  > 1000 ; //1000 µs = 1 ms
end;

procedure Delay;
var MyThread: TMyThread;
begin
MyThread := TMyThread.Create(true);
MyThread.Priority := tpNormal;
MyThread.FreeOnTerminate := true;
MyThread.Resume;
end;

procedure TForm2.Button4Click(Sender: TObject);
var start, ende : Cardinal;
begin
start:= GetTickCount;
   Delay;
ende:= GetTickCount;
MM(INTTOSTR(ende-start));
end;					

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

procedure MM(s:string); begin Form2.Memo1.Lines.Add(s); end;

procedure MyDelay(Milliseconds: Integer);
var
  a, b,  c: Int64;
  r: real;
begin
  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  repeat
    QueryPerformanceCounter(c);
    r:= (c - b) * 1000 / a;
                Application.ProcessMessages; //WICHTIG!
   until  r  >  Milliseconds ;

  MM(FloatToStrF(r, ffFixed, 12, 3)+' msec');
end;

procedure TForm2.Button8Click(Sender: TObject);
begin
  MyDelay(1000);
end;					

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

procedure MyDelay(Milliseconds: real);
var
  a, b,  c: Int64;
  r: real;
begin
  QueryPerformanceFrequency(a);
  QueryPerformanceCounter(b);
  repeat
    QueryPerformanceCounter(c);
    r:= (c - b) * 1000 / a;
        if Milliseconds >1 then Application.ProcessMessages; //WICHTIG!
  until  r  >=  Milliseconds ;

  MM(FloatToStrF(r, ffFixed, 12, 3)+' msec');
end;

procedure TForm2.Button10Click(Sender: TObject);
begin
 MyDelay(20.333);   //  Millisec
end;					

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

procedure TMyThread.Execute;
var
 AZ: TDatetime;
const
 WZ = 1000 / (60*60*24*1000); //1000 ms wartezeit
begin
AZ := Now;
while not Terminated do
  begin
  while (AZ+WZ > Now) do begin end; //nichts machen :D (sonst ggf. application.processmessages falls du in der gui arbeitest)
  AZ := Now;
  //WAS du alle WZ machen willst
  end;
end;					

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

uses
  DateUtils;

var
  NowZero: TDateTime;

function GetFrame: Integer;
const
  MSInterval = 20;      //Interval in Millisekunden zum anzeigen
  FramesPerSecond = 50; //Anzahl Frames pro Sekunde
var
  MSBetween: Int64;
begin
  MSBetween := MilliSecondsBetween(NowZero, Now);
  Result := (MSBetween div MSInterval) mod FramesPerSecond;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  NowZero := Now;
end;