Image Größe ändern - kann doch nicht so schwer sein?

[Timm Thaler]

Ich lade ein Bild im JPEG Format aus einem Stream und speichere es zweimal ab. Beim zweiten Mal soll das Bild auf 75% verkleinert sein.

Code: Alles auswählen

  image : TFPCustomImage;
  hread : TFPReaderJPEG;
  hwrite : TFPWriterJPEG;
begin
  try
    image := TFPMemoryImage.Create(0, 0);
    hread := TFPReaderJpeg.Create();
    hwrite := TFPWriterJpeg.Create();
    image.LoadFromStream(idata, hread);  // JPEG aus Stream
 
    image.SaveToFile(sfile1, hwrite);  // in Originalgröße speichern
    image.SetSize(960, 540);
    image.SaveToFile(sfile2, hwrite);  // in 75% Größe speichern
  finally
    image.Free;
    hread.Free;
    hwrite.Free;
  end;
end;

SetSize funktioniert schonmal nicht. Da wird zwar was gespeichert, auch in der richtigen Größe, aber das Bild ist zerstückelt. Nun lese ich in diversen Foren immer was von: TBitmap erzeugen, mit StretchDraw auf Bitmap zeichnen, Bitmap dem JPEG wieder zuweisen.

Ist das wirklich so umständlich? Und TBitmap funktioniert bei mir nicht, ich lasse das in der Konsole laufen und verwende die Units fpimage, fpwritejpeg, fpreadjpeg, fpcanvas, fpimgcanv. Ich kann auf das Bild auch mit Canvas zeichnen. Nur die Größe bekomme ich nicht angepasst.

Gibt es nicht sowas wie image.Resize()?

[mse]

Die Grösse von Pixmaps ändern ist nicht so einfach wie es scheint. Dazu werden Funktionen des Widgetset, des Betriebssystems oder einer externen Bibliothek benötigt. Warum kannst du TBitmap nicht in einer Konsolenanwendung verwenden? Hat dein Zielsystem keine Graphikunterstützung?
Die TBitmap von MSEgui kann mit GraphicsMagick arbeiten:
http://www.graphicsmagick.org/
https://gitlab.com/mseide-msegui/mseide ... stream.pas

Free Pascal hat eine Import Unit für ImageMagick:
https://svn.freepascal.org/cgi-bin/view ... iew=markup

GraphicsMagick ist ein Fork von ImageMagick.

Edit: Ein Blick in fpcanvas.pp zeigt:

Code: Alles auswählen

 
  TFPCustomInterpolation = class
 

, da müsste doch auch Grössenänderung vorhanden sein? Es gibt

Code: Alles auswählen

 
  TFPCustomCanvas = class(TPersistent)
[...]
    procedure StretchDraw (x,y,w,h:integer; source:TFPCustomImage);
 

Hast du das schon probiert?

[pluto]

Schau dir mal TPicture an... Das ist deutlich einfacher....

[Timm Thaler]

Hab das jetzt so gelöst, anhand eines rudimentären Beispiels (interpoldemo.pp) in den fcl-image-Sourcen:

Code: Alles auswählen

procedure ImageResize(const img : TFPCustomImage; xnew, ynew : integer);
var
  icanvas : TFPCustomCanvas;
  itemp : TFPCustomImage;
begin
  if (xnew > 0) and (ynew > 0) then begin
    try
      itemp := TFPMemoryImage.Create(xnew, ynew);
      icanvas := TFPImageCanvas.Create(itemp);
//      icanvas.Interpolation := TFPSharpInterpolation.Create;
      icanvas.StretchDraw(0, 0, xnew, ynew, img);
      img.Assign(itemp);
    finally
      icanvas.Free;
      itemp.Free;
    end;
  end;
end;

Das Bild wird auf ein temporäres Memory Image skaliert und dieses dann dem Bildhandler wieder zugewiesen. Funktioniert soweit.

Wie kann ich jetzt noch die Interpolation wählen (bezier, lancos...)? Gibt es sowas in der fcl-image-Lib?

[mse]

Wie kann ich jetzt noch die Interpolation wählen (bezier, lancos...)? Gibt es sowas in der fcl-image-Lib?

Schau mal in extinterpolation.pp:

Ein weiterer Blick in fpcanvas.pp zeigt:

Code: Alles auswählen

 
  TFPCustomCanvas = class(TPersistent)
[...]
    property Interpolation : TFPCustomInterpolation read FInterpolation write FInterpolation;
 

und in fpcanvas.inc:

Code: Alles auswählen

 
procedure TFPCustomCanvas.StretchDraw(x, y, w, h: integer; source: TFPCustomImage);
var i : TFPCustomInterpolation;
    FreeInterpolation : boolean;
    IP : TFPCustomInterpolation;
begin
  FreeInterpolation := not assigned (FInterpolation);
  if FreeInterpolation then
    IP := TMitchelInterpolation.Create
  else
    IP := FInterpolation;
  try
    with IP do
      begin
      Initialize (source, self);
      Execute (x,y,w,h);
      end;
  finally
    if FreeInterpolation then
      IP.Free;
  end;
end;
 

Erfahrungsgemäss sind die fpImage Funktionen nicht sehr schnell, vermutlich bist du mit GraphicsMagick besser bedient.

[Timm Thaler]

Ich hab jetzt mal verschiedene Filter getestet, ausgehend von dem hier: https://github.com/castle-engine/castle ... e.inc#L466

Code: Alles auswählen

procedure ImageResizeTest(const img : TFPCustomImage; xnew, ynew : integer);
const
  npol : array [1.. 6] of string = ('Nearest', 'Bilinear', 'Gaussian', 'Lanczos', 'Quadratic', 'Cubic');
  nr : integer = 1;
var
  icanvas : TFPCustomCanvas;
  itemp : TFPCustomImage;
  hwrite : TFPWriterJPEG;
  ttest : TDateTime;
  hipol : TFPBaseInterpolation;
  fname : string;
  k : integer;
begin
  if (xnew > 0) and (ynew > 0) then begin
    try
      hwrite := TFPWriterJpeg.Create();
      hwrite.CompressionQuality := 70;
      hwrite.ProgressiveEncoding := false;
      itemp := TFPMemoryImage.Create(xnew, ynew);
      icanvas := TFPImageCanvas.Create(itemp);
      for k := 1 to 6 do begin
        fname := pfdtmp + 'ipol' + RightStr('00' + IntToStr(nr), 2) + '-' + npol[k] + '.jpg';  // Filtertyp
        try
          ttest := Now();
          case k of
            1 : hipol := TBoxInterpolation.Create();
            2 : hipol := TBilineairInterpolation.Create();
            3 : hipol := TGaussianInterpolation.Create();
            4 : hipol := TLanczosInterpolation.Create();
            5 : hipol := TQuadraticInterpolation.Create();
            6 : hipol := TCubicInterpolation.Create();
          end;
          icanvas.StretchDraw(0, 0, xnew, ynew, img);
          WriteLn('Ipol ' + npol[k] + ': ' , MilliSecondsBetween(Now(), ttest));
          itemp.SaveToFile(fname, hwrite);
        finally
          hipol.Free;
        end;
      end;
    finally
      icanvas.Free;
      itemp.Free;
      hwrite.Free;
    end;
    Inc(nr);
  end;
end;

Ich bekomme immer Ausführungszeiten von um die 1000msec. Allerdings sehe ich absolut keinen Unterschied in den Bildern, ich bezweifle, dass die Filter überhaupt greifen. Wie kann man das überprüfen?

[pluto]

Ich bekomme immer Ausführungszeiten von um die 1000msec. Allerdings sehe ich absolut keinen Unterschied in den Bildern, ich bezweifle, dass die Filter überhaupt greifen. Wie kann man das überprüfen?

Ich bin mir nicht sicher, aber sie können gar nicht greifen. Du erstellst zwar "hipol" und gibt es wieder frei, aber wo verwendest du es? In diesem Code abschnitt?
oder wo übergibst du das "bitmap" an hipol?
Oder übersehe ich gerade was?

[wp_xyz]

Kennst du das: http://wiki.freepascal.org/Developing_w ... _LazCanvas? Hier geht es zwar um TBitmap, aber der Code zeigt, wie man die fcl-image-transformationen anwendet (was auch funktioniert, getestet)

[Timm Thaler]

Ich bin mir nicht sicher, aber sie können gar nicht greifen. Du erstellst zwar "hipol" und gibt es wieder frei, aber wo verwendest du es? In diesem Code abschnitt?
oder wo übergibst du das "bitmap" an hipol?

Ja, das hat mich auch gewundert, ich hatte es dann so verstanden, dass StretchDraw FInterpolation auf einen gesetzten Filter prüft und sonst TMitchelInterpolation nimmt.

Ich hab jetzt mal hipol durch icanvas.Interpolation ersetzt. Sieht erstmal noch genauso aus: 1000msec pro StretchDraw, egal welcher Filter, und die erzeugten Jpegs sind bis aufs Byte gleich groß.

Erfahrungsgemäss sind die fpImage Funktionen nicht sehr schnell, vermutlich bist du mit GraphicsMagick besser bedient.

Vermutlich komme ich besser, wenn ich die Interpolation lasse, die Bilder im Original ablege und dann bei der Zusammenfassung mit ffmpeg / avconv das erzeugte Video verkleinern lasse. FFmpeg ist es nämlich witzigerweise egal, ob ich große Bildern verkleinern lasse oder verkleinerte Bilder verwende, die Konvertierung dauert genauso lange.

[wp_xyz]

Egal wie du dich entscheidest, ich poste in der Anlage trotzdem noch den funktionsfähigen Code für die Skalierung eines Bildes mit Hilfe der verschiedenen Interpolations-Filter von FCL-Image, ohne TBitmap, also the LCL, zu benutzen.