PNG Image Gradient

[greenmile]

Hallo zusammen,

ich versuche es nun schon seit Stunden und bekomme es nicht hin. Ich habe ein PNG Image und möchte, dass das ab ca der Hälfte bis zum Ende transparent wird (also ab 50% mit jedem 10% Schritt mehr). Aber irgendwie bekomme ich den Dreh nicht raus. Hat vielleicht hat jemand nen Code-Schnipsel für mich oder einen Link?

Alternativ wäre ich auch für einen Code dankbar, der mir die Ecken rund macht. Alles, was ich im Netz gefunden habe, war entweder saulangsam oder hat nicht funktioniert.

Viele Grüße

[Uwe Raabe]

PngComponents hat in PngFunctions.pas eine Methode

Delphi-Quellcode:

MakeImageBlended

. Die macht das zwar mit dem ganzen Bild, aber das könnte dir eventuell ja weiter helfen.

[greenmile]

Super, das hat schonmal weitergeholfen, habe die Funktion kopiert und angepasst, läuft.
Hast du für "abgerundete Ecken" zufällig auch eine Idee? Als Quelle könnte BMP, PNG oder JPG geliefert werden.

[Blup]

Transparente abgerundete Ecken:

Delphi-Quellcode:

function CreateGrayScalePalette: HPalette;
var
  LogPalette: TMaxLogPalette;
  b: Byte;
begin
  LogPalette.palVersion    := $300;
  LogPalette.palNumEntries := 256;
  for b := 0 to 255 do
  begin
    with LogPalette.palPalEntry[b] do
    begin
      peRed   := b;
      peGreen := b;
      peBlue  := b;
    end;
  end;
  Result := CreatePalette(@LogPalette);
end;

procedure Set8BitGrayScale(ABitmap: TBitmap);
begin
  ABitmap.PixelFormat := pf8Bit;
  ABitmap.Palette := CreateGrayScalePalette;
end;

procedure SetAlphaRoundRect(AImage: TPngImage; dx, dy: Integer);
var
  BmpAlpha: TBitmap;
  y: Integer;
begin
  BmpAlpha := TBitmap.Create;
  try
    Set8BitGrayScale(BmpAlpha);
    {Hintergrund Schwarz}
    BmpAlpha.Canvas.Brush.Color := clBlack;
    BmpAlpha.SetSize(AImage.Width, AImage.Height);
    {sichtbaren Bereich Weiss füllen}
    BmpAlpha.Canvas.Pen.Style := psClear;
    BmpAlpha.Canvas.Brush.Color := clWhite;
    BmpAlpha.Canvas.RoundRect(BmpAlpha.Canvas.ClipRect, dx, dy);
    {Daten aus der Bitmap in den Alphachannel übernehmen}
    AImage.CreateAlpha;
    for y := 0 to AImage.Height - 1 do
    begin
      Move(BmpAlpha.ScanLine[y]^, AImage.AlphaScanline[y]^, AImage.Width);
    end;
  finally
    BmpAlpha.Free;
  end;
end;

procedure TForm1.TestClick(Sender: TObject);
var
  Image: TPngImage;
begin
  Image := TPngImage.Create;
  try
    Image.LoadFromFile('Background_Blue.png');

    SetAlphaRoundRect(Image, 20, 20);

    PaintBox1.Canvas.Draw(0, 0, Image);
  finally
    Image.Free;
  end;
end;

[greenmile]

Super, danke für den Source. Der funktioniert perfekt, ich schulde euch was!