unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TThreadTimer =
class(TThread)
//Threadtimer Deklaration
private
aktuelleZeit,startZeit: int64;
procedure Execute;
override;
//Edit Execute und OnTimer als private
procedure OnTimer;
published
constructor Create;
virtual;
end;
TForm1 =
class(TForm)
Label1: TLabel;
Button1: TButton;
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
ThreadTimer: TThreadTimer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
constructor TThreadTimer.Create;
begin
inherited create(True);
QueryPerformanceCounter(startZeit);
//Startzeit ermitteln
resume;
end;
procedure TThreadTimer.OnTimer;
Var T:integer;
Freq:int64;
begin
QueryPerformanceCounter(aktuelleZeit);
QueryPerformanceFrequency(Freq);
Freq:=Freq
div 1000;
//Um Millisekunden zu erhalten
T:=(aktuelleZeit-startZeit)
div Freq;
if T>9999
then //Abbruch bei 10 Sekunden //Edit oder wahlweise eine andere Aktion durchführen
Terminate;
Form1.Label1.Caption := IntToStr(T);
end;
procedure TThreadTimer.Execute;
begin
while not Terminated
do
begin
Synchronize(Self,OnTimer);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//Noch ein alter ThreadTimer vorhanden,wenn ja dann Beenden und Speicher freigeben
if Assigned(ThreadTimer)
then
begin
ThreadTimer.Terminate;
FreeandNil(ThreadTimer);
end;
ThreadTimer := TThreadTimer.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(ThreadTimer)
then
begin
ThreadTimer.Terminate;
FreeandNil(ThreadTimer);
end;
end;
end.