[Firemonkey] Canvas als PNG mit Transparenz speichern

[milos]

Hallo,

ich habe eine Firemonkey anwendung bei der der User auf ein TImage Canvas Zeichnen kann.
Wie kann ich diese nun als PNG speichern lassen ohne das ich die Transparenz auf der nicht gezeichneten Fläche verliere?

Freundliche Grüsse

Edit:
Ich hätte eigentlich gedacht das es so funktionieren sollte:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Bitmap.SaveToFile('./tmp.bmp');
end;

procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
  const [Ref] ARect: TRectF);
begin
  Canvas.Fill.Color := $ffff0000;
  Canvas.FillRect(RectF(0,0,50,50),0,0,[],1);
end;

Aber hier wird mir nur eine leere bmp datei abgespeichert :/

[Zacherl]

Dein Code zeichnet auf das Canvas vom Formular und nicht auf das vom Bitmap, oder?

[milos]

Zitat:

Zitat von Zacherl (Beitrag 1335345)

Dein Code zeichnet auf das Canvas vom Formular und nicht auf das vom Bitmap, oder?

Sicher? Weil das gezeichnete Rectangle startet genau dort wo auch das TImage ist und wenn ich den Code so schreibe ändert sich das Ergebnis leider auch nicht :/

Delphi-Quellcode:

procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
  const [Ref] ARect: TRectF);
begin
  Image1.Canvas.Fill.Color := $ffff0000;
  Image1.Canvas.FillRect(RectF(0,0,50,50),0,0,[],1);
end;

Was ich noch versucht habe ist:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  LBitmap := TBitmap.Create;
  LBitmap.Width := Image1.Bitmap.Width;
  LBitmap.Height := Image1.Bitmap.Height;

  Image1.Canvas.CopyBitmap(Image1.Bitmap, LBitmap);

  LBitmap.SaveToFile('./tmp.bmp');
end;

procedure TForm1.Image1Paint(Sender: TObject; Canvas: TCanvas;
  const [Ref] ARect: TRectF);
begin
  Image1.Bitmap.Width := round(Image1.Width);
  Image1.Bitmap.Height := round(Image1.Height);
  Canvas.Fill.Color := $ffff0000;
  Canvas.FillRect(RectF(0,0,50,50),0,0,[],1);
end;

Das speichert mir keine leere Datei mehr (also 0 bytes) sondern eine Datei die zwar 100x100 hat aber einfach nur schwarz ist und keinerlei Spuren der gezeichneten Dinge enthält.

Das kann doch nicht so schwer sein, irgendwo muss da ein Wurm oder Denkfehler drin sein auch wenn ich beim besten Willen nicht sehe wo der ist :/

Freundliche Grüsse

[Rollo62]

Wenn du ein Bmp hast könntest du damit Speichern

Delphi-Quellcode:

procedure S4Bmp_ToStream( bmpSrc   : TBitmap;
                          strmDst  : TStream;
                          sExt     : String;
                          iQuality : Integer);
var
  Surf        : TBitmapSurface;
  vBitMapData : TBitmapData;
  saveParams  : TBitmapCodecSaveParams;

begin
  Surf := TBitmapSurface.Create;

  // lock and get the bitmap pixels
  if  bmpSrc.Map(TMapAccess.Read, vBitMapData) then
  begin

      try
        Surf.Assign(bmpSrc);

        saveparams.Quality := iQuality; // 85;

        if not TBitmapCodecManager.SaveToStream(strmDst, Surf, sExt, @saveParams) then //'.jpg') then
            raise EBitmapSavingFailed.Create(
                  'Error saving Bitmap to ' + sExt);
    //      raise EBitmapSavingFailed.Create(SBitmapSavingFailed);
      finally
        Surf.Free;
      end;


      bmpSrc.Unmap(vBitMapData); // unlock the bitmap

  end;

end;


// Aufruf mit                                       Quality in %
S4Bmp_ToStream( bmpSrc, FileStream_als_Beispiel, '.png', 85);

Info: Den äussere Scope mit Bitmap.Map()... könnte man wohl auch weglassen,
ich hatte das noch von einem Test mit drin, aber ich denke das schadet auch nicht wenn es drin bleibt.


Eigentlich sollte das Canvas-Bitmap die Transparenz richtig drinhaben, müsstest du mal Testen.

Rollo

[milos]

Hallo,

danke für die antwort!
Leider bekomme ich damit wieder eine Leere Datei die aber die richtige grösse hat, jedoch keine gezeichneten Pixel enthält.

Ich zeichne nun direkt auf ein Bitmap und rufe deine Funktion so auf:

Delphi-Quellcode:

procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LStream : TFileStream;
begin
  LBitmap := TBitmap.Create; // erstelle bitmap
  LBitmap.Width := 50; // setze grösse
  LBitmap.Height := 50;

  LBitmap.Canvas.Fill.Color := $FFFF0000; // brush color auf rot setzen

  LBitmap.Canvas.DrawRect(RectF(0,0,10,50),0,0,[],1); // rectangle zeichnen

  LStream :=  TFileStream.Create('./DP.png', fmCreate or fmOpenWrite); // file stream erstellen

  S4Bmp_ToStream( LBitmap, LStream, '.png', 85); // funktionsaufruf
end;

Mache ich was falsch?

Im Anhang habe ich noch die DP.png angehängt die erzeugt wird. Sie ist da, aber eben halt ein leeres Bild... :/

Freundliche Grüsse und vielen dank für die Hilfe

[Harry Stahl]

Vielleicht erst mal was grundsätzliches: Intern verwendet FMX immer eine 32-bit Bitmap, also mit Transparenz. Wenn Du das speicherst, reicht es einen Dateityp zu wählen, der Transparenz kann (also z.B. '.png'), die Transparenz bleibt dann automatisch erhalten.

Zu Deinem Code: Ohne Beginscene und Endscene wirst Du i.d.R. nichts sehen.

Hier ein kleines Beispiel, das ein rotgefülltes Rundeck erzeugt. Wenn Du das dann mit dem Button "Speichere" speicherst und die Datei in einem Bildbearbeitungsprogramm öffnest, sieht das so wie in der Anlage aus (Transparenz wird durch das Schachmuster signalisiert).

Außerdem musst Du drauf achten, auf welchen Canvas Du Dich beziehst (also nicht den Form-Canvas verwenden).

Delphi-Quellcode:

unit Unit18;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.StdCtrls, FMX.Edit, FMX.Controls.Presentation;

type
  TForm18 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form18: TForm18;

implementation

{$R *.fmx}

procedure TForm18.Button1Click(Sender: TObject);
begin
  with image1.Bitmap.Canvas do begin
    if beginscene then begin
      try
        Fill.Color := TAlphaColorRec.red;
        FillRect(rectF (20,20, 100,100), 30,30,AllCorners,100);
      finally
        endscene;
      end;
    end;
  end;
end;

procedure TForm18.Button2Click(Sender: TObject);
begin
  image1.Bitmap.SaveToFile('D:\Test.png');
end;

procedure TForm18.FormCreate(Sender: TObject);
begin
  image1.Bitmap.SetSize(Round (image1.Width), Round (image1.Height));
end;

end.

[milos]

Zitat:

Zitat von Harry Stahl (Beitrag 1335429)

Vielleicht erst mal was grundsätzliches: Intern verwendet FMX immer eine 32-bit Bitmap, also mit Transparenz. Wenn Du das speicherst, reicht es einen Dateityp zu wählen, der Transparenz kann (also z.B. '.png'), die Transparenz bleibt dann automatisch erhalten.

Zu Deinem Code: Ohne Beginscene und Endscene wirst Du i.d.R. nichts sehen.

Hier ein kleines Beispiel, das ein rotgefülltes Rundeck erzeugt. Wenn Du das dann mit dem Button "Speichere" speicherst und die Datei in einem Bildbearbeitungsprogramm öffnest, sieht das so wie in der Anlage aus (Transparenz wird durch das Schachmuster signalisiert).

Außerdem musst Du drauf achten, auf welchen Canvas Du Dich beziehst (also nicht den Form-Canvas verwenden).

Danke Harry, das war der entscheidende Tipp und es funktioniert nun einwandfrei!

Vielen vielen dank, dachte mir schon das da etwas kleines aber wichtiges fehlt... Mir standen schon die Haare zu berge! :lol: :oops:

Freundliche Grüsse

[Rollo62]

Du solltest dir meinen Vorschlag auch nochmal ansehen, denn nicht alle Plattformen unterstützen alle Formate.

http://docwiki.embarcadero.com/Libra...aphics.TBitmap

http://docwiki.embarcadero.com/Libra...te_Bildformate

Rollo

[milos]

Zitat:

Zitat von Rollo62 (Beitrag 1335431)

Du solltest dir meinen Vorschlag auch nochmal ansehen, denn nicht alle Plattformen unterstützen alle Formate.

http://docwiki.embarcadero.com/Libra...aphics.TBitmap

http://docwiki.embarcadero.com/Libra...te_Bildformate

Rollo

Guter Hinweis. :thumb:

Sobald ich mit Begin/EndScene arbeite kann ich auch ohne Probleme mit TBitmapSufrace das Canvas abspeichern. Danke! :-D

Freundliche Grüsse