// Farben (Farbschattierungen) in einer PNG werden transparent
// (halbtransparent) gemacht, wobei man mit "Range" (Bereich)
// festlegen kann, wie ähnlich die transparenten Stellen der
// angegebenen Farbe sein sollen.


// Getestet mit RS 10.4 unter Win11

uses Vcl.Imaging.PngImage; 
 
var 
  png: TPngImage; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  png := TPngImage.create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(png); 
end; 
 
procedure SemiTransp(p: TPngImage; Colr: TColor; Value: Byte; Range: Byte = 0); 
var 
  slf, sla: PByteArray; 
  hlp: TPngImage; 
  X, Y: Integer; 
  r, g, b: Byte; 
begin 
  hlp := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, p.Width, p.Height); 
  hlp.CreateAlpha; 
  hlp.Canvas.draw(0, 0, p); 
  Colr := ColorToRGB(Colr); 
  r := GetRValue(Colr); 
  g := GetGValue(Colr); 
  b := GetBValue(Colr); 
  for Y := 0 to pred(hlp.Height) do 
  begin 
    sla := hlp.AlphaScanline[Y]; 
    slf := hlp.SCanline[Y]; 
    for X := 0 to pred(hlp.Width) do 
    begin 
      if (abs(b - slf^[X * 3]) <= Range) and (abs(g - slf^[X * 3 + 1]) <= Range) 
        and (abs(r - slf^[X * 3 + 2]) <= Range) then 
        sla^[X] := 255 - Value 
      else 
        sla^[X] := 255; 
    end; 
  end; 
  p.assign(hlp); 
  FreeAndNil(hlp); 
end;

 
// Beispiel:
// Karierter Untergrund scheint durch die Farbe Rot (Mantel)
// und Orange (Nase)



procedure TForm1.Button1Click(Sender: TObject); 
var 
  Staerke, Bereich: Byte; 
begin 
  Staerke := 128; // 255 = komplett transparent 
  Bereich := 180; // 255 = alle Farben und Schattierungen 
  png.LoadFromFile('D:\Bilder\WeihnMann.png'); 
  SemiTransp(png, clRed, Staerke, Bereich); 
 
  With Form1.Canvas do 
  begin 
    Pen.Color := clBlue; 
    Brush.Color := clYellow; 
    Brush.style := bsCross; 
    FillRect(ClipRect); 
    draw(50, 50, png); 
  end; 
end;

Zugriffe seit 6.9.2001 auf Delphi-Ecke