// Getestet mit RS 10.4 unter Win11

// Variante 1

// In dieser Variante wird eine transparente PNG mit den
// Abmaßen 200 x 200  über den Umweg einer Bitmap erzeugt.

uses 
  Vcl.Imaging.PngImage; 
 
var 
  png: TPngImage; 
  bmp: TBitmap; 
  Transparenz: TColor = clBlack; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  bmp := TBitmap.Create(200, 200);  
  bmp.Canvas.Brush.Color := Transparenz; 
  bmp.Canvas.FillRect(bmp.Canvas.ClipRect); 
  bmp.Transparent := true; 
  png := TPngImage.Create; 
  png.Assign(bmp); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(png); 
  FreeAndNil(bmp); 
end; 
 
// kleines Anwendungs-Beispiel 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  // zum Testen 
  with png, Canvas do 
  begin 
    Pen.Width := 10; 
    Brush.Style := bsClear; 
    Pen.Color := clRed; 
    RecTangle(5, 5, Width -5, Height -5);
    Brush.Color := clYellow; 
    Pen.Color := clBlue; 
    Ellipse(20, 15, 120, 115); 
  end; 
  png.SaveToFile('D:\Test.png'); // z.B. 
  Form1.Canvas.Draw(10, 10, png); // z.B. 
end;

//-----------------------------------------

// Variante 2

// Das Ergebnis dieser Variante ist das gleiche, aber die
// Transparenz wird über den Alphakanal erzeugt.

uses 
  Vcl.Imaging.PngImage; 
 
var 
  png: TPngImage; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, 200, 200); 
  png.CreateAlpha; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(png); 
end; 
 
// Anwendungsbeispiel 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  slf, sla: PByteArray; 
  X, Y: Integer; 
begin 
  with png, Canvas do 
  begin 
    Pen.Width := 10; 
    Brush.Style := bsClear; 
    Pen.Color := clRed; 
    RecTangle(5, 5, Width -5, Height -5); 
    Brush.Color := clYellow; 
    Pen.Color := clBlue; 
    Ellipse(20, 15, 120, 115); 
  end; 
 
 for Y := 0 to pred(png.Height) do 
  begin 
    sla := png.AlphaScanline[Y]; 
    slf := png.SCanline[Y]; 
    for X := 0 to pred(png.Width) do 
    begin 
      if (slf^[X * 3] <> 0) or (slf^[X * 3 + 1] <> 0) or (slf^[X * 3 + 2] <> 0) 
      then 
        sla^[X] := 255; 
    end; 
  end;
 
  png.SaveToFile('D:\Test.png'); // z.B.
  Form1.Canvas.Draw(10, 10, png); // z.B. 
end; 

Zugriffe seit 6.9.2001 auf Delphi-Ecke