Arbeiten mit TThreadList

[Sir Rufo]

Hier mal ein Beispiel-Thread, der sich nach außen hin "harmlos" verhält.

Delphi-Quellcode:

TMyForm = class( TForm )
  procedure Button1Click( Sender:TObject );
private
  FMyThread : TMyThread;
public
  procedure AfterConstruction; override;
  procedure BeforeDestruction; override;
end;

procedure TMyThread.Button1Click( Sender:TObject );
var
  LFoo : TFoo;
begin
  // Feed the Thread ...
  LFoo := TFoo.Create;
  try
    FMyThread.WorkOnItem( LFoo );
    LFoo := nil; // Wenn die Instanz vom Thread übernommen wurde, dann hier auf nil setzen
  finally
    LFoo.Free; // stellt bei einer Exception sicher, dass die Instanz freigegeben wird
  end;
end;

procedure TMyForm.AfterConstruction;
begin
  inherited;
  FMyThread :=TMyThread.Create;
end;

procedure TMyForm.BeforeDestruction;
begin
  FreeAndNil( FMyThread );
  // erst wenn die Thread-Instanz wirklich freigegeben werden konnte, dann geht es hier weiter
  inherited;
end;

Delphi-Quellcode:

unit Unit1;

interface

// In älteren Delphi-Versionen hat die Thread-Klasse noch keine TerminatedSet-Methode.
// Dann bitte das nachfolgende {$DEFINE USE_TERMINATEDSET} ausschalten

{$DEFINE USE_TERMINATEDSET }

uses
  Classes, SyncObjs, Contnrs;

type
  TMyThread = class( TThread )
  private
    FCS : TCriticalSection;
    FEvent : TEvent;
    FToDoList : TObjectList;
    procedure DoWorkOnItem( Item : TObject );
    function GetItem : TObject;
  protected
    procedure Execute; override;
{$IFDEF USE_TERMINATEDSET}
    procedure TerminatedSet; override;
{$ENDIF}
  public
    constructor Create;
    destructor Destroy; override;

    // Übergabe eines WorkItems an den Thread.
    // Der Thread übernimmt die Kontrolle über die Item-Instanz
    // und gibt diese bei Bedarf auch wieder frei
    // - Nach dem Abarbeiten
    // - Beim Beenden, wenn noch Items in der Liste enthalten sind

    procedure WorkOnItem( Item : TObject );
  end;

implementation

{ TMyThread }

constructor TMyThread.Create;
begin
  inherited Create( False ); // <-- NEIN, der Thread soll nie, nicht, niemals schlafen

  FCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, False, False, '' );
  FToDoList := TObjectList.Create( True );
end;

destructor TMyThread.Destroy;
begin
{$IFDEF USE_TERMINATEDSET}
  // hier einfach nichts machen ... abwarten und Tee trinken
{$ELSE}
  Terminate;
  FEvent.SetEvent;
{$ENDIF}
  inherited;

  // jetzt alle Instanzen freigeben
  FToDoList.Free;
  FEvent.Free;
  FCS.Free;
end;

procedure TMyThread.DoWorkOnItem( Item : TObject );
begin
  // Hier irgendetwas mit dem Item machen
end;

procedure TMyThread.Execute;
var
  LItem : TObject;
begin
  inherited;
  // die übliche Schleife ...
  while not Terminated do
    begin
      // Warten, bis es etwas zu arbeiten gibt
      FEvent.WaitFor;
      // Wenn der Event gefeuert wurde, prüfen wir mal ob ...
      if not Terminated
      then
        begin
          // Item aus der ToDoListe holen
          LItem := GetItem;
          try
            // Mit dem Item arbeiten
            DoWorkOnItem( LItem );
          finally
            // Item-Instanz freigeben
            LItem.Free;
          end;
        end;
    end;
end;

function TMyThread.GetItem : TObject;
begin
  FCS.Enter;
  try
    // Item aus der ToDoListe entnehmen
    Result := FToDoList.Extract( FToDoList.First );
    // Wenn dort nocht Items enthalten sind, dann setzen wir den Event auch wieder
    if FToDoList.Count > 0
    then
      FEvent.SetEvent;
  finally
    FCS.Leave;
  end;
end;

{$IFDEF USE_TERMINATEDSET}

procedure TMyThread.TerminatedSet;
begin
  inherited;
  // Wenn Terminted, dann braucht hier keiner mehr warten
  FEvent.SetEvent;
end;
{$ENDIF}

procedure TMyThread.WorkOnItem( Item : TObject );
begin
  FCS.Enter;
  try
    // Item in die ToDoListe einfügen
    FToDoList.Add( Item );
    // und per Event den Thread aufwecken
    FEvent.SetEvent;
  finally
    FCS.Enter;
  end;
end;

end.

UPDATE TThread.TerminatedSet ist mit XE2 gekommen