There are two kinds of transparency:
- Color transparency, the kind we were talking about so far: one specific color is defined as "transparent color"; only the pixels with a different color are painted.
- Alpha-channel transparency: Each pixel contains information for red, green and blue, but also for its transparency. These are 4 bytes again, like in TColor. BUT: TColor uses the 4th byte for system colors and thus is not available for the alpha channel. Therefore, the LCL canvas cannot handle alpha-channel transparency...
Fortunately, the FCL provides another graphics library,
fcl-image, in which a color (type TFPColor here) is a record of 16-bit Red, Green, Blue and Alpha elements. The Lazarus unit
IntfGraphics, in addition, provides
TLazIntfImage which is a descendant of the basic fcl-image class, TFPCustomImage, but can also understand LCL bitmaps. Utilizing this, we can then iterate over all pixels in the image and replace those pixels with RGB equal to the RGB of the transparent color by pixels for which the Alpha channel is fully transparent (alphaTransparent, in the terms of fcl-image).
The next obstacle is saving to file. To be honest I do not know of a way how to save an alpha-channel transparent image as bmp file - I am always losing the alpha channel. But the png format, on the other hand, is well-prepared for an alpha-channel, and it even provides some good amount of compression. fcl-image can find the needed writer unit from the extension of the destination file, but for keeping the alpha channel we must set the writer's UseAlpha property to true. Therefore, we must create the writer explicitely to get access to this property.
In total, the following procedure should do everything needed to save a color-transparent bitmap to an alpha-channel transparent png image file:
uses
fpImage, // TFPColor
fpWritePNG, // PNG writer
IntfGraphics, // TLazIntfImage
...;
procedure SaveBitmapAsTransparentPNG(ABitmap: TBitmap; AFileName: String);
var
img: TLazIntfImage;
pixColor: TFPColor;
transpColor: TFPColor;
writerPNG: TFPWriterPNG;
x, y: Integer;
begin
// Determine the transparent color of the TBitmap.
// Note: Use TColorToFPColor to convert an LCL TColor value to an fcl-image TFPColor
if ABitmap.TransparentMode = tmFixed then
transpColor := TColorToFPColor(ABitmap.TransparentColor)
else
transpColor := TColorToFPColor(ABitmap.Canvas.Pixels[0, 0]);
// Create a TLazIntfImage from the bitmap
img := ABitmap.CreateIntfImage;
try
// Iterate over all pixels, find the pixels with the transparent color
// and replace them by a FPColor with alpha=0
for y := 0 to img.Height - 1 do
for x := 0 to img.Width - 1 do
begin
// Read the FPColor of the pixel at x,y.
pixColor := img.Colors[x, y];
// ... set its Alpha value
if (pixColor.Red = transpColor.Red) and
(pixColor.Green = transpColor.Green) and
(pixColor.Blue = transpColor.Blue)
then
pixColor.Alpha := alphaTransparent
else
pixColor.Alpha := alphaOpaque;
// ... and write the modified pixel back into the LazIntfImage.
img.Colors[x, y] := pixColor;
end;
// Create a writer class for the PNG format
writerPNG := TFPWriterPNG.Create;
try
// Activate alpha channel in the file output
writerPNG.UseAlpha := true;
// Save LazIntfImage to file.
img.SaveToFile(AFileName, writerPNG);
finally
writerPNG.Free;
end;
finally
img.Free;
end;
end;
: The pixel format of the LazIntfImage corresponds to that of the bitmap calling CreateIntfImage. Therefore, the TBitmap passed to this procedure must have been created with PixelFormat pf32Bit. Otherwise the LazIntfImage will not be constructed with an alpha channel.
procedure TFormVonKoch.ButtonVonKochFileClick(Sender: TObject);
VAR
Bitmap: TBitmap;
Curve : TVonKochCurve;
BEGIN
IF SavePictureDialog.Execute
THEN BEGIN
Screen.Cursor := crHourGlass;
TRY
Bitmap := TBitmap.Create;
TRY
Bitmap.Width := SpinEditKochSize.Value;
Bitmap.Height := SpinEditKochSize.Value;
Bitmap.PixelFormat := pf32bit; // IMPORTANT!
Bitmap.canvas.Brush.Color := clWhite;
Bitmap.Canvas.FillRect(0, 0, Bitmap.Width, Bitmap.Height);
{
Place the drawing code here...
}
SaveBitmapAsTransparentPNG(Bitmap, SavePictureDialog.FileName);
FINALLY
Bitmap.Free
END
FINALLY
Screen.Cursor := crDefault
END
END
end;
Recent
