Timing-Event im 10ms-Bereich

[MaxDelphi]

Hallo Leute,

nochmals Danke für eure Hilfe. Oftmals sind es doch die Anregungen der anderen die einen wieder frei denken lassen, so daß einem neue Suchbegriffe einfallen und einen zum Ergebnis führen. Bei mir waren das "time slice" -> "win32priorityseparation" -> "quantum" -> "timeBeginPeriod" -> und schon war ich wieder bei euch gelandet und zwar:

Delphi für Win32
Schneller Timer gesucht
Im 11. Beitrag hat Gandalfus den Link zu einem guten Tutorial gepostet, womit mir gelungen ist was ich gesucht habe -> Timing-Events <= 10ms ohne Prozessorlast. Wobei die Genauigkeit der 10ms nicht so bedeutend sind, sondern ich wollte auf ca. 100Hz kommen.

Ich hänge ein kleines Programm an, das dem besagten Tutorial entnommen ist und von mir modifiziert wurde. Es enthält wieder Now und nun glaube ich es auch: Now ist nicht besonders exakt!! Aber wenn man die Events eine Weile auflaufen läßt und die verstrichen ms von Now durch die Anzahl der Durchläufe teilt kommt man wieder auf ca. 10ms.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, mmsystem, StdCtrls; //!!!!  mmsystem einbinden (für timegettime)
type
   TMsgContainer   = class
   public
      Msg   : string;
   end;

  TThreadTimer = class(TThread)
  private
    TheMsg: TMsgContainer;
    Zeit: int64;
    t0   : TDateTime;
    Cnt   : Int64;
  published
    procedure Execute; override;
    procedure OnTimer;
    constructor CreateMitCanvas(AMsg: TMsgContainer); virtual;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    ThreadTimer: TThreadTimer;
    Timerid: integer;
    MyMsg   : TMsgContainer;
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

//Dem constructor wird eine zeichenfläche übergeben,
//damit klar ist wohin gezeichnet werden soll
constructor TThreadTimer.CreateMitCanvas(AMsg: TMsgContainer);
begin
  inherited create(true);
  TheMsg := AMsg;
  Zeit := Timegettime ;          //Die Startzeit wird ermittelt
  t0   := Now;
  Cnt   := 0;
  resume;
end;

procedure TThreadTimer.Execute;
begin
  while not Terminated do
  begin
    sleep(1);
    OnTimer;
  end;
end;

procedure TThreadTimer.OnTimer;
Var
   NewTime, Delay   : int64;
   ElapsedMS   : TDateTime;
begin
   NewTime   := timegettime;
   Delay   := NewTime-Zeit;
   ElapsedMS   := (Now-t0)*86400000;
  if NewTime-Zeit>=9 then //Jeweil nach einer Sekunde
  begin
   Inc(Cnt);
    TheMsg.Msg   := TheMsg.Msg   + Format('%.3d %8.3fms %d',[Cnt,ElapsedMS,delay]) + #13#10;
    zeit:= NewTime; //neue Start Zeit ermitteln
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   MyMsg   := TMsgContainer.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyMsg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   MyMsg.Msg   := '';
  ThreadTimer := TThreadTimer.CreateMitCanvas(MyMsg);
  Button1.Enabled   := False;
  Button2.Enabled   := True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   ThreadTimer.DoTerminate;
  ThreadTimer.free; //Timer freigeben
  memo1.Text   := MyMsg.Msg;
  Button2.Enabled   := False;
  Button1.Enabled   := True;
end;

end.

Damit sehe ich das Problem als gelöst an.
Nochmals vielen Dank für eure Mühe.