Polling im TThread

[Sir Rufo]

Zitat von Uwe Raabe:

Den Event beim Terminate auslösen geht am elegantesten, wenn man DoTerminate überschreibt.

Öhm, wenn du damit mal nicht auf die Nase fällst, denn DoTerminate wird aufgerufen, wenn das Terminieren (Beenden) beginnt -> die Execute-methode verlassen wurde.

TerminatedSet ist da wesentlich geschickter

[Uwe Raabe]

Zitat von Sir Rufo:

TerminatedSet ist da wesentlich geschickter

Die hatte ich auch eigentlich gemeint - beim Tippen stand der Editor halt grad auf der falschen Methode. Ich weiß nur nicht, ob es die in XE schon gab.

[Sir Rufo]

Das ist mit dem Event gemeint:

Delphi-Quellcode:

unit TimerThread;

interface

uses
  System.Classes,
  System.SyncObjs;

const
  TIMERTHREAD_INTERVAL_DEFAULT = 1000;
  TIMERTHREAD_ENABLED_DEFAULT = True;

type
  TTimerThread = class( TThread )
  private
    FCS : TCriticalSection;
    FEvent : TEvent;
    FInterval : Cardinal;
    FEnabled : Boolean;
    procedure SetInterval( const Value : Cardinal );
    function GetInterval : Cardinal;
    procedure SetEnabled( const Value : Boolean );
    function GetEnabled : Boolean;
  protected
    procedure Execute; override; final;
    procedure ExecuteTimed; virtual;
    // ACHTUNG! Das gibt es erst ab Delphi XE2
    procedure TerminatedSet; override;
  public
    constructor Create;
    destructor Destroy; override;

    property Interval : Cardinal read GetInterval write SetInterval default TIMERTHREAD_INTERVAL_DEFAULT;
    property Enabled : Boolean read GetEnabled write SetEnabled default TIMERTHREAD_ENABLED_DEFAULT;
  end;

implementation

{ TTimerThread }

constructor TTimerThread.Create;
begin
  FCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, False, False, '' );
  inherited Create( False );
  FInterval := TIMERTHREAD_INTERVAL_DEFAULT;
end;

destructor TTimerThread.Destroy;
begin

  inherited;
  FEvent.Free;
  FCS.Free;
end;

procedure TTimerThread.Execute;
var
  LInterval : Cardinal;
begin
  inherited;
  while not Terminated do
    begin
      if Enabled then
        LInterval := Interval
      else
        LInterval := INFINITE;

      if FEvent.WaitFor( Interval ) = TWaitResult.wrTimeout
      then
        ExecuteTimed;
    end;
end;

procedure TTimerThread.ExecuteTimed;
begin

end;

function TTimerThread.GetEnabled : Boolean;
begin
  FCS.Enter;
  try
    Result := FEnabled;
  finally
    FCS.Leave;
  end;
end;

function TTimerThread.GetInterval : Cardinal;
begin
  FCS.Enter;
  try
    Result := FInterval;
  finally
    FCS.Leave;
  end;
end;

procedure TTimerThread.SetEnabled( const Value : Boolean );
begin
  FCS.Enter;
  try
    FEnabled := Value;
  finally
    FCS.Leave;
  end;
end;

procedure TTimerThread.SetInterval( const Value : Cardinal );
begin
  FCS.Enter;
  try
    FInterval := Value;
    FEvent.SetEvent;
  finally
    FCS.Leave;
  end;
end;

procedure TTimerThread.TerminatedSet;
begin
  inherited;
  FEvent.SetEvent;
end;

end.

Allerdings gibt es dieses TThread.TerminatedSet erst ab Delphi XE2 und für die Funktion unerlässlich. Einen Workaround für alles kleiner XE2 habe ich gerade nicht zur Hand.