Polling im TThread

[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.