Autor Beitrag
Gausi
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8432
Erhaltene Danke: 439

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.2 CE
BeitragVerfasst: Di 17.09.19 17:31 
Ich hab da schon wieder ein Problemchen, wo mir eine Internetrecherche auch nicht so wirklich hilft. :les:

Grundproblem ist das nicht Thread-sichere TBitmap. Also "nicht threadsicher" in dem Sinne, dass man TBitmap eigentlich überhaupt nicht in Threads abseits vom VCL-Thread nutzen sollte. Problematisch ist da wohl der Zugriff auf Canvas, der auf globale Konstrukte zurückgreift und daher absolut unsafe ist. Ich hatte in dem Kontext vor Jahren auch mal den Fall, dass eine Anwendung sauber lief, solange man den Mauscursor nicht bewegt hat ... :lol:

Als Alternative soll TBitmap32 aus der Sammlung Graphics32 threadsafe sein.

Soweit, so gut. Jetzt möchte ich aber im Kontext eines Threads Bilder laden (meistens Jpegs, gelegentlich PNGs), und diese verkleinert anderswo abspeichern - als Jpeg. Eine Klasse TJpegImage32 gibt es in dieser Sammlung nicht, und das übliche TJpegImage soll auch nicht threadsafe sein. Blöd.

Wenn man aber in den Code von TBitmap32 schaut, dann findet man da z.B. auch sowas
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
procedure TCustomBitmap32.LoadFromFile(const FileName: string);
var P: TPicture;
begin
   /// [ ... ]
  // if we got here, use the fallback approach via TPicture...
  P := TPicture.Create;
  try
    P.LoadFromFile(FileName);
    Assign(P);
  finally
    P.Free;
  end;
end;

Damit ist man über TPicture ja voll drin in den ganzen Nicht-Threadsicheren TGraphic-Klassen.

Oder heißt das, dass ich im sicheren Bereich bin, solange ich von den "alten" Klassen nur Assign (in beide Richtungen) und Load/SaveFrom/ToFile/Stream nutze, und den ganzen Manipulationscode (verkleinern) über TBitmap32 laufen lasse?

Einfach testen und gucken, obs läuft, ist dabei ja nicht so eine gute Idee. Bei Threads ist das ja generell nicht vernünftig. Erschwerend kommt hinzu, dass mein eigentlich unsafer TBitmap-Code aktuell gut durchläuft. 15 Minuten rödeln, dabei 5000 Bilder umskalieren, während auf der Mainform auch fröhlich gemalt wird - kein Problem. Aber dem Braten trau ich nicht. :roll:

Weiß da jemand mehr Bescheid? Oder hat einen guten Link zur Hand?

_________________
Oel ngati kameie.
Gausi Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8432
Erhaltene Danke: 439

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.2 CE
BeitragVerfasst: So 29.09.19 09:50 
Im später erstellten Crossposting in der DP wurde mir empfohlen, dafür auf die Windows Imaging Component zurückzugreifen. Dabei auch nicht die TGraphic-Kapselung TWICImage zu nutzen, sondern alles zu Fuß. Denn dabei wird intern auch auf TBitmap und Canvas zurückgegriffen, die Implementierung ist nicht gerade vollständig, und das Kernstück (die WICImagingFactory) geht über eine Class Var, was mit Threads auch böse enden könnte ...

Herausgekommen ist dann dieser Code, der auf den ersten Blick etwas abschreckend wirkt (alleine schon wegen der vielen Variablen).

Einige weitere Anmerkungen dazu:
Parameter
  • aStream: Ein Stream mit Bilddaten (FileStream von einer Bilddatei, MemoryStream mit Bilddaten aus einem ID3-Tag, ...)
  • aFilename: Dateiname der Zieldatei
  • destWidth/destHeight: Zielgröße des Bildes. Das Originalbild wird so skaliert, dass es in das Rechteck destWidth*destHeight hineinpasst
  • aWICImagingFactory: eine WICImagingFactory, damit diese bei vielen Skalierungen nicht immer neu erstellt werden muss. Bei NIL wird eine lokale neu erzeugt.
  • Overwrite: Flag, das in meiner Anwendung gelegentlich gebraucht wird. Damit werden bereits vorhandene Dateien überschrieben, ansonsten wird abgebrochen - aber trotzdem "Erfolg" zurückgeliefert. Das ist in meinem Anwendungsfall so sinnvoll.

Rückgabewert:
  • True, falls das skalierte Bild erfolgreich erstellt wurde (oder ggf. bereits existiert)

Das Bildformat wird automatisch aus dem Stream ermittelt. Das Ausgabeformat ist immer JPEG. Eine ggf. vorhandene WICImagingFactory muss im Kontext des Threads erzeugt werden, in dem die Funktion laufen soll. Fehlerbehandlung könnte intensiver sein, und ein Rückgabewert mit mehr Info als "hat geklappt" wäre ggf. auch sinnvoll. Das ist dann aber dem geneigten Leser zur Übung überlassen. :mrgreen:

Aber das sollte dann so ziemlich Threadsafe sein, komplett ohne VCL und TGraphic. Und ich kann die externe Bibliothek Graphics32 wieder aus dem Projekt entfernen und dabei 200-300kb an der exe sparen. :angel:
ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
function ScalePicStreamToFile(aStream: TStream; aFilename: UnicodeString; destWidth, destHeight: Integer; aWICImagingFactory: IWICImagingFactory; OverWrite: Boolean = False): boolean;
var
    hr: HRESULT;
    isLocalFactory: Boolean;
    // for proper scaling
    xfactor, yfactor:double;
    origWidth, origHeight: Cardinal;
    newWidth, newHeight: Cardinal;
    // reading the source image
    SourceAdapter: IStream;
    BitmapDecoder: IWICBitmapDecoder;
    DecodeFrame: IWICBitmapFrameDecode;
    SourceBitmap: IWICBitmap;
    SourceScaler: IWICBitmapScaler;
    // writing the resized image
    DestStream: TMemoryStream;
    DestAdapter: IStream;
    DestWICStream: IWICStream;
    BitmapEncoder: IWICBitmapEncoder;
    EncodeFrame: IWICBitmapFrameEncode;
    Props: IPropertyBag2;
begin
    result := False;
    if Not Overwrite and FileExists(aFilename) then
    begin
        result := True;
        exit;
    end;

    isLocalFactory := (aWICImagingFactory = nil);
    if isLocalFactory then
        CoCreateInstance(CLSID_WICImagingFactory, nil, CLSCTX_INPROC_SERVER or
          CLSCTX_LOCAL_SERVER, IUnknown, aWICImagingFactory);

    // read the image data from stream
    SourceAdapter := TStreamAdapter.Create(aStream);
    hr := aWICImagingFactory.CreateDecoderFromStream(SourceAdapter, guid_null, WICDecodeMetadataCacheOnDemand, BitmapDecoder);
    if Succeeded(hr) then hr := BitmapDecoder.GetFrame(0, DecodeFrame);
    if Succeeded(hr) then hr := aWICImagingFactory.CreateBitmapFromSource(DecodeFrame, WICBitmapCacheOnLoad, SourceBitmap);
    if Succeeded(hr) then hr := SourceBitmap.GetSize(origWidth, origHeight);

    // calculate proper scaling
    xfactor:= (destWidth) / origWidth;
    yfactor:= (destHeight) / origHeight;
    if xfactor > yfactor then
    begin
        newWidth := round(origWidth * yfactor);
        newHeight := round(origHeight * yfactor);
    end else
    begin
        newWidth := round(origWidth * xfactor);
        newHeight := round(origHeight * xfactor);
    end;

    // scale the original image
    if Succeeded(hr) then hr := aWICImagingFactory.CreateBitmapScaler(SourceScaler);
    if Succeeded(hr) then hr := SourceScaler.Initialize(SourceBitmap, NewWidth, NewHeight, WICBitmapInterpolationModeFant);

    if Succeeded(hr) then
    begin
        // Reading and scaling the original image was successful.
        // Now try to save the scaled image
        DestStream := TMemoryStream.create;
        try
            // create new WICStream
            DestAdapter := TStreamAdapter.Create(DestStream);
            if Succeeded(hr) then hr := aWICImagingFactory.CreateStream(DestWICStream);
            if Succeeded(hr) then hr := DestWICStream.InitializeFromIStream(DestAdapter);
            // create and prepare JPEG-Encoder
            if Succeeded(hr) then hr := aWICImagingFactory.CreateEncoder(GUID_ContainerFormatJpeg, guid_null, BitmapEncoder);
            if Succeeded(hr) then hr := BitmapEncoder.Initialize(DestWICStream, WICBitmapEncoderNoCache);
            if Succeeded(hr) then hr := BitmapEncoder.CreateNewFrame(EncodeFrame, Props);
            if Succeeded(hr) then hr := EncodeFrame.Initialize(Props);
            if Succeeded(hr) then hr := EncodeFrame.SetSize(newWidth, newHeight);
            // write image data
            if Succeeded(hr) then hr := EncodeFrame.WriteSource(SourceScaler, nil);
            if Succeeded(hr) then hr := EncodeFrame.Commit;
            if Succeeded(hr) then hr := BitmapEncoder.Commit;
            // finally save the stream to the destination file
            if Succeeded(hr) then
                try
                    DestStream.SaveToFile(aFilename);
                    result := True;
                except
                    // silent exception here, but (try to) delete the destination file, if it exists
                    result := False; 
                    if FileExists(aFilename) then DeleteFile(aFilename);
                end;
        finally
            DestStream.Free;
        end;
    end;

    if isLocalFactory then
        aWICImagingFactory._Release;
end;

_________________
Oel ngati kameie.

Für diesen Beitrag haben gedankt: Narses
Sinspin
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 1192
Erhaltene Danke: 100

Win7
DXE2 Prof, Lazarus
BeitragVerfasst: So 29.09.19 10:20 
Interessante sache. Ich arbeite gerade mit Lazarus / FPC an einem Projekt wo tausende Dateien laden und auswerten muss. Ich bin mal gespannt wie es dort klappt parallel zu laden.
Ich kenne jedenfalls kein einziges kommerzielles Programm das diesen Flschenhals nicht hat. Ein Videoschnitt Tool das ich früher mal verwendet habe, arbeitete mit mehreren Workerprogrammen die gestartet wurden um Dateien schneller einlesen zu können. Nach dem einlesen wurden die Daten via SharedMem/Pipes dann ins Hauptprogramm gepumpt.

_________________
Solange keine Zeile Code geschrieben ist, läuft ein Programm immer fehlerfrei.
Ich teste nicht, weil ich Angst habe Fehler zu finden.
Gausi Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 8432
Erhaltene Danke: 439

Windows 7, Windows 10
D7 PE, Delphi XE3 Prof, Delphi 10.2 CE
BeitragVerfasst: So 29.09.19 10:44 
Bei mir geht es nicht darum, mehrere Bilder parallel zu skalieren. Ich brauche das für den Aufbau der Medienbibliothek meines MP3-Players. Die Cover werden dafür in einem separatem Ordner gesammelt. In der Medienbibliothek wird dann nur eine CoverID zu jedem Titel gespeichert, die dann dem Dateinamen des skalierten Covers entspricht.

Die Dateisuche für den Aufbau der Bibliothek läuft schon länger in einem Neben-Thread. Wenn ich aber für jede gefundene Datei das Untersuchen eben dieser Datei im VCL-Thread erledige (inklusive Coversuche), dann wird die Anwendung sehr träge bedienbar. Das sieht einfach unschön aus. Und weil das praktisch das erste ist, was man beim ausprobieren tun muss, liefert das einen echt blöden ersten Eindruck. ;-)

Wenn das skalieren und die Metdaten-Findung komplett im Nebenthread passiert, und nur alle 200 Millisekunden (oder so) eine Statusaktualisierung erfolgt ("scanne 12.356/34.567"), läuft das ganze flüssig durch.

Mehrere parallele Lese- und Schreiboperationen sind ja je nach Datenträger eh nicht unbedingt empfehlenswert. Ich muss das einfach auslagern in einen Nicht-VCL-Thread. Das ist alles. Und das ist mit Bitmaps manchmal ganz, ganz böse. :?

_________________
Oel ngati kameie.