AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Thread Exception beim laden von Thumbnails

Thread Exception beim laden von Thumbnails

Ein Thema von ts_abc · begonnen am 17. Jan 2019 · letzter Beitrag vom 21. Jan 2019
Antwort Antwort
ts_abc

Registriert seit: 22. Sep 2003
20 Beiträge
 
Delphi 10 Seattle Professional
 
#1

Thread Exception beim laden von Thumbnails

  Alt 17. Jan 2019, 20:25
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;

Geändert von ts_abc (17. Jan 2019 um 22:27 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Gausi
Gausi

Registriert seit: 17. Jul 2005
881 Beiträge
 
Delphi 11 Alexandria
 
#2

AW: Thread Exception beim laden von Thumbnails

  Alt 18. Jan 2019, 12:08
Soweit ich weiß, ist TBitmap nicht Thread-safe. Nicht nur in dem Sinne, dass man da beim Zugriff von verschiedenen Threads heraus vorsichtig sein muss, sondern sogar so, dass TBitmap generell nur im VCL-Hauptthread verwendet werden darf. Selbst völlig Thread-lokale Bitmaps, die nur im Kontext des Threads erstellt, bearbeitet und wieder zerstört werden, können Probleme machen.

Und wenn ich deinen Code richtig sehe, überträgst du Bitmaps über Threadgrenzen hinweg. Schön verpackt mit CriticalSections, aber soweit ich weiß, hilft das bei Bitmaps nicht.
The angels have the phone box.
  Mit Zitat antworten Zitat
ts_abc

Registriert seit: 22. Sep 2003
20 Beiträge
 
Delphi 10 Seattle Professional
 
#3

AW: Thread Exception beim laden von Thumbnails

  Alt 19. Jan 2019, 20:15
Mm, Gausi das wäre jetzt aber wirklich doof, da hab ich aber ein echtes Problem. Denn alleine schon der vom BS zurückgegebene Thumbnail ist ein HBitmap. Das komische ist aber dass wenn nicht der Vorgefertigte Bitmap aus der Ressource verwendet wird es auch nicht kracht.

Ich glaub in dem Fall, ist noch irgendwo ein anderes Problem. Ich stelle da mal ne wage Vermutung an, ich glaub der Thread hat irgendwo ein Problem mit dem schnelleren verarbeiten des im Speicher liegenden Bitmap. Er scheint wohl irgendwo dann zu kollidieren wenn der Hauptthread noch nicht fertig ist. Im Moment kommen die Thumbnails noch von einer normalen mechanischen Festplatte und es kracht dabei nicht. Ich frag mich gerade was passiert wenn es von einer SSD kommt, ich werde das mal testen.
  Mit Zitat antworten Zitat
19. Jan 2019, 20:57
Dieses Thema wurde am "19. Jan 2019, 20:57 Uhr" von "Luckie" aus dem Forum "Programmieren allgemein" in das Forum "Multimedia" verschoben.
Benutzerbild von Bernhard Geyer
Bernhard Geyer

Registriert seit: 13. Aug 2002
17.198 Beiträge
 
Delphi 10.4 Sydney
 
#5

AW: Thread Exception beim laden von Thumbnails

  Alt 19. Jan 2019, 20:59
Windows Ressourcen sind Thread-Affin.
Sie sind nur im erzeugenden Thread gültig.
Du kannst sie nicht über Threadgrenzen hinweg übertragen.
Windows Vista - Eine neue Erfahrung in Fehlern.
  Mit Zitat antworten Zitat
ts_abc

Registriert seit: 22. Sep 2003
20 Beiträge
 
Delphi 10 Seattle Professional
 
#6

AW: Thread Exception beim laden von Thumbnails

  Alt 21. Jan 2019, 22:48
Puh Ok, ich hoffe ich habe den Fehler gefunden, jetzt läuft alles wie es soll. Der Fehler wurde wie es aussieht ausgelöst, in der Komponente TFileThumb. Diese arbeitet ebenfalls mit einem Bitmap aus dem Grunde, da das BS einen HBitmap als Thumbnail liefert. Hierbei war natürlich kein Look, Unlook beim arbeiten mit dem BMP drin. Somit flog mir das Ganze an dieser Stelle:
Delphi-Quellcode:
procedure TAnThumbThread.DoExecute;
var tBmp, tmpBmp: TBitmap; iPic: String; LParams: TAnThumbParam;
begin
  ...
    try
      if LParams.BuildType = btImg48Thumb then
        if FFileThumb.Size <> 128 then FFileThumb.Size := 128
      else
        if FFileThumb.Size <> 256 then FFileThumb.Size := 256;

      ...
    finally
      ...
    end;

  ...
end;
um die Ohren.

@Bernhard Geyer
Ne, ich werde mich hüten das zu mach , ich übertrage es Natürlich nicht direkt sondern Zeichne es auf dem Output.

Ok Luckie Danke, aber wieso in das Thema Multimedia?
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:10 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz