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.