Save bitmap with transparency as .png in VCL

Here is an example how to save a bitmap containing an alpha channel as a .png image using Delphi VCL.

In Delphi VCL you can use the TPngImage component to work with .png images. The only problem is that if you assign a bitmap to a TPngImage using PngImage.Assign(Bitmap) the alpha channel is lost.

I found the following solution thanks to this discussion on a German forum. So in stead of assigning the bitmap to the TPngImage object, you create a new blank TPngImage with alpha channel enabled and draw the bitmap on the TPngImage canvas.

After that you copy the alpha channel of the bitmap to the TPngImage in a separate step.

So in this example I render an SVG image to a bitmap and save the bitmap as a .png image (thanks to Thomas Wassermann).

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  BVE.SVG2SaxParser,
  BVE.SVG2Intf,
  BVE.SVG2Types,
  BVE.SVG2ELements.VCL,
  Vcl.Imaging.pngimage;

{$R *.dfm}

// Source: http://www.entwickler-ecke.de/topic_Bitmap+pf32bit+mit+Alpha+afPremultipied+zu+PNG+speichern_103159,0.html

type
  TRGB = packed record B, G, R: byte end;
  TRGBA = packed record B, G, R, A: byte end;
  TRGBAArray = array[0..0] of TRGBA;

function PNG4TransparentBitMap(aBitmap:TBitmap): TPNGImage;
var
  X, Y: integer;
  BmpRGBA: ^TRGBAArray;
  PngRGB: ^TRGB;
begin
  //201011 Thomas Wassermann

  Result := TPNGImage.CreateBlank(COLOR_RGBALPHA, 8, aBitmap.Width , aBitmap.Height);

  Result.CreateAlpha;
  Result.Canvas.CopyMode:= cmSrcCopy;
  Result.Canvas.Draw(0, 0, aBitmap);

  for Y := 0 to Pred(aBitmap.Height) do
  begin
    BmpRGBA := aBitmap.ScanLine[Y];
    PngRGB:= Result.Scanline[Y];

    for X := 0 to Pred(aBitmap.width) do
    begin
      Result.AlphaScanline[Y][X] :=  BmpRGBA[X].A;
      if aBitmap.AlphaFormat in [afDefined, afPremultiplied] then
      begin
        if BmpRGBA[X].A <> 0 then
        begin
          PngRGB^.B := Round(BmpRGBA[X].B / BmpRGBA[X].A * 255);
          PngRGB^.R := Round(BmpRGBA[X].R / BmpRGBA[X].A * 255);
          PngRGB^.G := Round(BmpRGBA[X].G / BmpRGBA[X].A * 255);
        end else begin
          PngRGB^.B := Round(BmpRGBA[X].B * 255);
          PngRGB^.R := Round(BmpRGBA[X].R * 255);
          PngRGB^.G := Round(BmpRGBA[X].G * 255);
        end;
      end;
      Inc(PngRGB);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: string;
  SVGParser: TSVGSaxParser;
  SVGRoot: ISVGRoot;
  Bitmap: TBitmap;
  Png : TPngImage;
begin
  if OpenDialog1.Execute then
  begin
    FileName := OpenDialog1.FileName;

    // Create a root to store the SVG rendering tree

    SVGRoot := TSVGRootVCL.Create;

    // Create a SAX parser instance

    SVGParser := TSVGSaxParser.Create(nil);
    try

      // Parse SVG document and build the rendering tree

      SVGParser.Parse('', FileName, SVGRoot);

      // Create a bitmap

      Bitmap := TBitmap.Create;
      try
        Bitmap.PixelFormat := TPixelFormat.pf32bit;   // 32bit bitmap
        Bitmap.AlphaFormat := TAlphaFormat.afDefined; // Enable alpha channel

        Bitmap.SetSize(480, 320);            // Set desired size
        Bitmap.Canvas.Brush.Color := clNone; // Fill background with transparent
        Bitmap.Canvas.FillRect(Rect(0, 0, 480, 320));

        // Render the SVG onto the bitmap

        SVGRenderToBitmap(
          SVGRoot, // The root containing the rendering tree
          Bitmap   // The destination bitmap
          );

        // Create the png component

        Png := PNG4TransparentBitMap(Bitmap);
        try
          FileName := ChangeFileExt(FileName, '.png');
          Png.SaveToFile(FileName);
        finally
          Png.Free;
        end;

      finally
        Bitmap.Free;
      end;

    finally
      SVGParser.Free;
    end;
  end;
end;

end.