Thema: Delphi Timer ohne Timer

Einzelnen Beitrag anzeigen

busybyte

Registriert seit: 15. Sep 2006
165 Beiträge
 
#5

Re: Timer ohne Timer

  Alt 16. Jan 2010, 17:37
Delphi-Quellcode:
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.
I love DiscCat
  Mit Zitat antworten Zitat