Delphi-PRAXiS - Delphi Thread Exception beim laden von Thumbnails

Hallo,
ich habe ein Problem bei diesem Thread er Produziert eine Exception, aber nur wenn kein Thumb geladen werden kann da das Bild, Video... nicht vorhanden ist. Ich starte beim laden der Form einen Thread der alle Thumbnails nach und nach in einen TListView auf der Form aktualiesiert.

Wenn z.B. die Datei nicht vorhanden ist soll ein aus einer Ressource geladener Thumb angezeigt werden, dieser wird zu Beginn im Create des Thread in eine erstellte Bitmap Variable zur Verfügung gestellt.

Wenn alle Dateien vorhanden sind läuft alles wie erwartet ohne Probleme, so bald aber zwei Dateien aufeinander fehlen Rumst es. Dabei wird bei der ersten fehlenden Datei der Thumb noch angezeigt, bei der zweiten fehlt er schon. Das komische ist wenn ich hinter FEvent.WaitFor; in Execute ein Sleep(150); einbaue verbessert sich das ganze erheblich, fast immer geht er dann durch es rumst dann nur noch selten.

Der Debugger gibt verschiedene Exceptions aus beim ersten Mal EOutOfResources 'Systemressourcen erschöpft', dann noch beim erneuten Aufruf der Form EOutOfResources 'Das Handle ist ungültig'.
Die gute Frage ist nun wie bekomme ich jetzt raus warum es rumst und wo?

Thumbnail Thread:

Delphi-Quellcode:

			unit AnPSThread;

interface

uses

  System.Generics.Collections, System.Classes, System.SyncObjs, Vcl.Graphics,

  AnPSFuncClass, AnPSThumbN;

type

  TAnThumbEvent = procedure(Sender: TObject; aWS: Pointer) of object;

  TBuildType = (btImg48Thumb, btFullThumb);

  TAnThumbParam = record

    iWS: Pointer;

    PFile: String;

    BuildType: TBuildType;

    constructor Create(aPFile: String; aWS: Pointer;

      aBuildType: TBuildType);

  end;

  TAnThumbThread = class(TThread)

  private

    FEvent: TEvent;

    FInputCS: TCriticalSection;

    FOutputCS: TCriticalSection;

    FInputQueue: TQueue<TAnThumbParam>;

    FFileThumb: TFileThumb;

    FOutput: TBitmap;

    FOnOutputChanged: TAnThumbEvent;

    FNoFile: TBitmap;

    procedure SetOutput(const Value: TBitmap);

    procedure SetOnOutputChanged(const Value: TAnThumbEvent);

    function GetOnOutputChanged: TAnThumbEvent;

    procedure DoOutputChanged(aWS: PWorkStateItem);

  protected

    procedure Execute; override;

    procedure TerminatedSet; override;

    function GetThumbParam: TAnThumbParam;

    procedure DoExecute;

  public

    constructor Create;

    destructor Destroy; override;

    procedure Add(AThumbParam: TAnThumbParam);

    procedure Get(ABitmap: TBitmap);

    property OnOutputChanged: TAnThumbEvent read GetOnOutputChanged write SetOnOutputChanged;

  end;

implementation

uses System.SysUtils;

{ TAnThumbParam }

constructor TAnThumbParam.Create(aPFile: String; aWS: Pointer;

  aBuildType: TBuildType);

begin

  iWS := aWS;

  PFile := aPFile;

  BuildType := aBuildType;

end;

{ TAnThumbThread }

procedure TAnThumbThread.Add(AThumbParam: TAnThumbParam);

begin

  FInputCS.Enter;

  try

    FInputQueue.Enqueue(AThumbParam);

    FEvent.SetEvent;

  finally

    FInputCS.Leave;

  end;

end;

constructor TAnThumbThread.Create;

begin

  FInputCS := TCriticalSection.Create;

  FOutputCS := TCriticalSection.Create;

  FEvent := TEvent.Create(nil, True, False, '');

  FInputQueue := TQueue<TAnThumbParam>.Create;

  FFileThumb := TFileThumb.Create;

  FFileThumb.Size := 256;

  FOutput := TBitmap.Create;

  FNoFile := TBitmap.Create;

  FNoFile.LoadFromResourceName(hInstance, 'NoFileFound');

  FNoFile.Transparent := True;

  inherited Create;

end;

destructor TAnThumbThread.Destroy;

begin

  inherited;

  FInputQueue.Free;

  FOutput.Free;

  FNoFile.Free;

  FFileThumb.Free;

  FOutputCS.Free;

  FInputCS.Free;

  FEvent.Free;

end;

procedure TAnThumbThread.DoExecute;

var tBmp, tmpBmp: TBitmap; iPic: String; LParams: TAnThumbParam;

begin

  // Parameter aus Queue holen

  LParams := GetThumbParam;

  tBmp := TBitmap.Create;

  tmpBmp := TBitmap.Create;

  try

    // Thumb erstellen

    tBmp.Canvas.Lock;

    FNoFile.Canvas.Lock;

    tmpBmp.Canvas.Lock;

    try

      if LParams.BuildType = btImg48Thumb then

        if FFileThumb.Size <> 128 then FFileThumb.Size := 128

      else

        if FFileThumb.Size <> 256 then FFileThumb.Size := 256;

      iPic := LParams.PFile;

      if (iPic = '') or (not FileExists(iPic)) then begin

        tmpBmp.Assign(FNoFile);

        tmpBmp.Transparent := True;

      end else begin

        FFileThumb.FilePath := iPic;

        tmpBmp.Assign(FFileThumb.ThumbBmp);

      end;

      AddThumbToOutBmp(tmpBmp, tBmp);

    finally

      tBmp.Canvas.Unlock;

      FNoFile.Canvas.Unlock;

      tmpBmp.Canvas.Unlock;

    end;

    // Thumb in die Ausgabe schreiben

    SetOutput(tBmp);

  finally

    tBmp.Free;

    tmpBmp.Free;

  end;

  // Benachrichtigen

  Synchronize(

    procedure begin

      DoOutputChanged(LParams.iWS);

    end);

end;

procedure TAnThumbThread.DoOutputChanged(aWS: PWorkStateItem);

var LEvent: TAnThumbEvent;

begin

  LEvent := OnOutputChanged;

  if Assigned(LEvent) then LEvent(Self, aWS);

end;

procedure TAnThumbThread.Execute;

begin

  inherited;

  while not Terminated do begin

    FEvent.WaitFor;

    //Sleep(150);

    if not Terminated then DoExecute;

  end;

end;

procedure TAnThumbThread.Get(ABitmap: TBitmap);

begin

  FOutputCS.Enter;

  try

    if Assigned(FOutput) then ABitmap.Assign(FOutput);

  finally

    FOutputCS.Leave;

  end;

end;

function TAnThumbThread.GetThumbParam: TAnThumbParam;

begin

  FInputCS.Enter;

  try

    Result := FInputQueue.Dequeue;

    if (FInputQueue.Count = 0) and not Terminated then FEvent.ResetEvent;

  finally

    FInputCS.Leave;

  end;

end;

function TAnThumbThread.GetOnOutputChanged: TAnThumbEvent;

begin

  FOutputCS.Enter;

  try

    Result := FOnOutputChanged;

  finally

    FOutputCS.Leave;

  end;

end;

procedure TAnThumbThread.SetOnOutputChanged(const Value: TAnThumbEvent);

begin

  FOutputCS.Enter;

  try

    FOnOutputChanged := Value;

  finally

    FOutputCS.Leave;

  end;

end;

procedure TAnThumbThread.SetOutput(const Value: TBitmap);

begin

  FOutputCS.Enter;

  try

    FOutput.Assign(Value);

  finally

    FOutputCS.Leave;

  end;

end;

procedure TAnThumbThread.TerminatedSet;

begin

  inherited;

  FEvent.SetEvent;

end;

end.

Form:

Delphi-Quellcode:

			procedure TForm2.BeforeDestruction;

begin

  inherited;

  FThumbThread.OnOutputChanged := nil;

  FThumbThread.Free;

end;

// Benachrichtigung vom Thread, Thumb in ListView aktualisieren

procedure TForm2.ThumbOutputChanged(Sender: TObject;

  aWS: Pointer);

var idx: Integer; iLV: TListItem; r: Cardinal;

begin

  iLV := nil;

  ThumbBmp.Canvas.Lock;

  try

    FThumbThread.Get(ThumbBmp);

    try

      AddPointToThumb(ThumbBmp, aWS);

      idx := ImageList1.AddMasked(ThumbBmp, clFuchsia);

      iLV := ListView1.FindData(0, aWS, True, False);

      if Assigned(iLV) then iLV.ImageIndex := idx;

    finally

    end;

  finally

    ThumbBmp.Canvas.Unlock;

  end;

end;

procedure TForm2.FormCreate(Sender: TObject);

var i: Integer;

begin

  FThumbThread := TAnThumbThread.Create;

  FThumbThread.OnOutputChanged := ThumbOutputChanged;

  InitializeWS;

end;

// Abzuarbeitende Thumbs übergeben

procedure TForm2.InitializeWS;

var i: Integer; iWS: Pointer; iLV: TListItem;

begin

  ListView1.Items.BeginUpdate;

  try

    ListView1.Clear;

    for i:=0 to FSModul.FS_Out_WSData.Count - 1 do begin

      iWS := FSModul.FS_Out_WSData[i];

      ...

      iLV := ListView1.Items.Add;

      iLV.Data := iWS;

      iLV.Caption := iWS^.Name;

      iLV.ImageIndex := -1;

      FThumbThread.Add(TAnThumbParam.Create(iWS^.Dir+iWS^.Name, iWS,

        btImg48Thumb));

    end;

  finally

    ListView1.Items.EndUpdate;

  end;

end;