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]
