[Threads] Textureloader - Einige Fragen

[sirius]

Ahja, WaitforSingleObject. Man kann ja auch auf Threads, Processe, Semaphore ... warten.

Ich würde die ThreadObjectQueue im Textureloader erstellen und zerstören. Ich bastel mal alles zusammen und baue ein Event ein. Keine Garantie, dass es direkt so funktioniert

Delphi-Quellcode:

type 
  TThreadQueue = class(TObjectQueue) 
    private 
      FLock: TRTLCriticalSection; //Es gibt auch die Klasse TCriticalSection, aber es besteht kein Unterschied zur direkten Verwendung der WinAPI-Funktionen
      FEvent: TEvent; //Wie bei der Critical Section, kannst du hier auch direkt die WinAPI nutzen; in der Klasse TEvent sind ein paar Vereinfachungen
    public 
      constructor Create; 
      destructor Destroy; override; 

      function Push(AObject: TObject): TObject; 
      function Pop: TObject; 
      function Peek: TObject; 

      property Event:TEvent read FEvent;
  end; 

[...] 

constructor TThreadQueue.Create; 
begin 
  inherited Create; 
  InitializeCriticalSection(FLock) 
  FEvent:=TEvent.create; //evtl. initialisieren?
end; 

destructor TThreadQueue.Destroy; 
begin 
  EnterCriticalSection(FLock); 
  try 
    while (List.Count <> 0) do 
      (inherited Pop).Free; 
    FEvent.free;
    inherited Destroy; 
  finally 
    LeaveCriticalSection(FLock); 
    DeleteCriticalSection(FLock); 
  end; 
end; 

function TThreadQueue.Push(AObject: TObject): TObject; 
begin 
  //neues Objekt in der Klasse, also Event feuern
  EnterCriticalSection(FLock); 
  try 
    Result := inherited Push(AObject); 
    FEvent.SetEvent; 
  finally 
    LeaveCriticalSection(FLock); 
  end; 
end; 

function TThreadQueue.Pop: TObject; 
begin 
  EnterCriticalSection(FLock); 
  try 
    Result := inherited Pop; 
  finally 
    LeaveCriticalSection(Flock); 
  end; 
end; 

function TThreadQueue.Peek: TObject; 
//Was jetzt peek macht, weis ich nicht, deswegen ändere ich hier nix
begin 
  EnterCriticalSection(FLock); 
  try 
    Result := inherited Peek; 
  finally 
    LeaveCriticalSection(FLock); 
  end; 
end;

Delphi-Quellcode:

 TTextureLoader = class(TThread) 
    private 
      FQueue:  TThreadQueue
      FCurJob: TJob;         // Aktueller Job (für die Synchronize-Prozeduren) 

      procedure SyncGenTex; 
      procedure SyncFailed; 
      procedure SyncSucceeded; 
    public 
      constructor Create; 
      destructor Destroy; override; 

      

      procedure AddTexture(Path: String; Texture: TglBitmap2D; 
                           OnFinish: TFinishProc = nil);  
    protected
      procedure DoTerminate; override; //Hier muss noch das Event gesetzt werden, sondet endet der Thread nicht
      procedure Execute; override; 
  end; 

[...] 
  
procedure TTextureLoader.AddTexture(Path: string; Texture: TglBitmap2D; 
                                    OnFinish: TGFinishProc = nil); 
// Das Texture-Objekt wird immer schon vor Aufruf dieser Funktion angelegt. 
// OnFinish bietet die Möglichkeit, "Bescheid" zu geben, wenn die Textur fertig ist oder nicht geladen werden kann 
var 
  Job: TJob; 
begin 
  if FileExists(Path) and Assigned(Texture) then begin 
    Job := TJob.Create; 
    Job.Path := Path; 
    Job.Texture := Texture; 
    Job.OnFinish := OnFinish; 

    FQueue.Push(Job); 

    // Falls Thread angehalten wurde, wieder aufnehmen 
    //das macht jetzt die Queue. Du kannst natürlich SetEvent hier aufrufen und generell in die ThreadKlasse legen; weis nicht, was besser ist.
  end; 
end; 

procedure TTextureLoader.Execute; 
begin 
  while not Terminated do begin 

    // Schlafen legen, wenn keine Jobs mehr vorhanden sind, um den Thread zu erhalten 
    if (FQueue.Count = 0) then 
      FQueue.Event.Waitfor(infinite); // = waitforsingleobject ohne Zeitbegrenzung
      //hier bei nochmal auf terminated abfragen
    else begin 
      //hier evtl. Event.ResetEvent aufrufen

      FCurJob := MTGJob(fQueue.Pop); 

      // Eventuell noch ein try..finally rumbasteln, um FCurJob sicher freizugeben und einen Fehler in SyncFailed abzufangen 
      try 
        FCurJob.Texture.LoadFromFile(FCurJob.Path); 
        Synchronize(SyncGenTex); 

        Synchronize(SyncSucceeded); 
        FCurJob.Free; 
      except 
        on E: Exception do 
          Synchronize(SyncFailed); 
      end; // try..except 
    end; // if..then..else 

  end; // while 
end; 

procedure TTexturLoader.DoTerminate; 
begin
  inherited;
  FQueue.Event.setevent;
end;

Ich denke, ich habe nix vergessen.