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).

[code language=”Delphi”]
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.

[/code]

 

 

 

Random SVG star

Here is small application that morphs between star shapes.

The VCL project looks like this: The form color is set to “black” and it contains an TSVG2Image aligned “alClient” and a TTimer.

Also, the “DoubleBuffered” property of the form is set to “True”, otherwise we’ll end up with a lot of unwanted flicker.

RandomStar1

Then the following code in the unit:

[code language="Delphi"]

unit Unit1;

// -----------------------------------------------------------------------------
//
// Random SVG star
//
// B.J.H. Verhue
//
// -----------------------------------------------------------------------------

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls,
  BVE.SVG2Image.VCL;

type
  TForm1 = class(TForm)
    SVG2Image1: TSVG2Image;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure SVG2Image1Click(Sender: TObject);
  private
    FTime: integer;
    function LFO(const f: single): single;
    function LFO2(const s, f: single): single;
  public
    function StarPath(const aEdgeCount: integer; const aRIn, aROut, aOuterEdge: single): string;
    procedure Update;
  end;

var
  Form1: TForm1;

implementation
uses
  Vcl.Clipbrd,
  System.Math;

{$R *.dfm}

{ TForm1 }

function TForm1.LFO(const f: single): single;
begin
  // Low frequency oscilator

  Result := Sin(2* PI * f * FTime / 1000);
end;

function TForm1.LFO2(const s, f: single): single;
begin
  // Coupled LFO's to simulate randomness

  Result := LFO(s * LFO(f));
end;

function SVGColor(const aR, aG, aB: single): string;
begin
  Result := '#'
     + IntToHex(Round(255 * Abs(aR)), 2)
     + IntToHex(Round(255 * Abs(aG)), 2)
     + IntToHex(Round(255 * Abs(aB)), 2);
end;

function TForm1.StarPath(const aEdgeCount: integer; const aRIn, aROut,
  aOuterEdge: single): string;
var
  i: integer;
  InnerAngle, OuterAngle, X, Y: single;
begin
  // Create starshaped pathdata
  // aEdgeCount : number of edges or points
  // aRIn       : radius of star core
  // aROuter    : outer radius of star
  // aOuterEdge : width of star point

  Result := '';

  InnerAngle := 2 * PI / aEdgeCount;
  OuterAngle := arctan2(aOuterEdge, aROut);

  for i := 0 to aEdgeCount - 1 do
  begin
    X := aRIn * Sin(i * InnerAngle);
    Y := aRIn * Cos(i * InnerAngle);

    if i = 0 then
      Result := Result + Format('M%0:.2f,%1:.2f', [X, Y])
    else
      Result := Result + Format('L%0:.2f,%1:.2f', [X, Y]);

    X := aROut * Sin((i + 0.5 - OuterAngle) * InnerAngle);
    Y := aROut * Cos((i + 0.5 - OuterAngle) * InnerAngle);
    Result := Result + Format('L%0:.2f,%1:.2f', [X, Y]);

    X := aROut * Sin((i + 0.5 + OuterAngle) * InnerAngle);
    Y := aROut * Cos((i + 0.5 + OuterAngle) * InnerAngle);
    Result := Result + Format('L%0:.2f,%1:.2f', [X, Y]);

  end;
  Result := Result + 'Z"/&amp;gt;';
end;

procedure TForm1.SVG2Image1Click(Sender: TObject);
begin
  Timer1.Enabled := not Timer1.Enabled;

  // Put SVG on clipboard if paused

  if not Timer1.Enabled then
    Clipboard.AsText := SVG2Image1.SVG.Text;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Timer interval is set to 25ms, FPS=40

  Update;
  Inc(FTime, Timer1.Interval);
end;

procedure TForm1.Update;
begin
  // Create SVG content and assign to SVG2Image

  SVG2Image1.SVG.Text :=
      '&amp;lt;svg version="1.1" id="star"' + ' viewBox="-100 -100 200 200"' + ' xmlns="http://www.w3.org/2000/svg"&amp;gt;'

  // Defs section with a random radial gradient

    + ' &amp;lt;defs&amp;gt;'
      + ' &amp;lt;radialGradient id="radGrad1"&amp;gt;'
      + ' &amp;lt;stop offset="0%" stop-color="' + SVGColor(LFO2(0.01, 0.02), LFO2(0.015, 0.03), LFO2(0.008, 0.015)) + '" /&amp;gt;'
      + ' &amp;lt;stop offset="100%" stop-color="' + SVGColor(LFO2(0.02, 0.01), LFO2(0.025, 0.015), LFO2(0.03, 0.008)) + '" /&amp;gt;'
      + ' &amp;lt;/radialGradient&amp;gt;'
    + '&amp;lt;/defs&amp;gt;'

  // Path element with random starshape

    + '&amp;lt;path stroke="pink" fill="url(#radGrad1)" stroke-width="3" d="' + StarPath( Round(19 + 16 * LFO2(0.01, 0.01)), 50 + 30 * LFO2(0.03, 0.005), 80 + 10 * LFO2(0.008, 0.01), 16 + 16 * LFO2(0.01, 0.002)) + '"/&amp;gt;'

    + '&amp;lt;/svg&amp;gt;';

  SVG2Image1.Repaint;
end;

initialization
  // Set decimal seperator for "Format" function
  FormatSettings.DecimalSeparator := '.';

end.
[/code]

Sources can be found on github. To compile the examples, you need the demo or the full version of the SVG control package.

Enable transparency with TSVG2ImageList on VCL

There was a little bug in the package which prevented the proper rendering of images with transparency on the VCL TButton, so I uploaded a new fix which corrects this. After download of the fixed package you should rebuild the packages. The demo packages are update also.

In this post I would like to show how you can set properties on the TSVG2ImageList to enable transparency.

First there is the question what type of button you should select from the Tool Palette in the Delphi IDE. There is a TButton, a TBitBtn and a TSpeedButton.

It turns out that the TBitBtn and TSpeedButton are legacy controls and you should avoid using these in new applications. The illustration below shows why:

TSVG2ImageList1

There is  a Fuchsia color border on the TBitBtn and TSpeedButton control, that is because it uses the old windows method of simulating transparency by using the left (or right, not sure) bottom pixel as a transparency color. Before it copies the image from the image list, it clears the target area with color Fuchsia. On the pixels that should be semi transparent this Fuchsia color seeps through.

So TBitBtn and TSpeedButton should be avoided, the TButton, shows the correct image.

In this test application linked the image list to the ActionManager1 and added a couple of actions. On each action I set the ImageIndex of the corresponding image in the SVG2ImageList. Next linked one of the Actions to TButton.

On the TButton you also have to set the “Images” property to link to an image list. Then you have the option to set a number of image index properties on the TButton to show different images depending on the state of the button.

Finally here are the properties of the TSVG2ImageList to enable transparency:

TSVG2ImageList2

All color settings, especially “BkColor” should be set to “clNone” and “ColorDepth” should be set to “cd32Bit”.