Delphi - gradial fade of bitmap edges

Question

Any library/code to fade the edges of a bitmap in a gradient manner?

Something like this:

Edit: final code

Ok came up with this code after your example, it's ~10 times faster after optimization with scanlines. Ideally I think I should convert it to use a 32bit bitmap instead and modify the actual alpha layer, but this works for now, ty!

procedure FadeEdges(b: TBitmap; Depth, Start, Col: TColor);
Var f, x, y, i: Integer;
    w,h: Integer;
    pArrays: Array of pRGBArray;
    xAlpha: Array of byte;
    sR, sG, sB: Byte;
    a,a2: Double;
    r1,g1,b1: Double;
    Lx,Lx2: Integer;
procedure AlphaBlendPixel(X, Y: Integer);
begin
  pArrays[y,x].rgbtRed   := Round(r1 + pArrays[y,x].rgbtRed   * a2);
  pArrays[y,x].rgbtGreen := Round(g1 + pArrays[y,x].rgbtGreen * a2);
  pArrays[y,x].rgbtBlue  := Round(b1 + pArrays[y,x].rgbtBlue  * a2);
end;
procedure AlphaBlendRow(Row: Integer; Alpha: Byte);
Var bR, bG, bB, xA: Byte;
    t: Integer;
    s,s2: Double;
begin
  s  := alpha / 255;
  s2 := (255 - Alpha) / 255;

  for t := 0 to b.Width-1 do begin
    bR := pArrays[Row,t].rgbtRed;
    bG := pArrays[Row,t].rgbtGreen;
    bB := pArrays[Row,t].rgbtBlue;
    pArrays[Row,t].rgbtRed   := Round(sR*s + bR*s2);
    pArrays[Row,t].rgbtGreen := Round(sG*s + bG*s2);
    pArrays[Row,t].rgbtBlue  := Round(sB*s + bB*s2);
  end;
end;
begin
  b.PixelFormat := pf24bit;

  // cache scanlines
  SetLength(pArrays,b.Height);
  for y := 0 to b.Height-1 do
   pArrays[y] := pRGBArray(b.ScanLine[y]);

  // pre-calc Alpha
  SetLength(xAlpha,Depth);
  for y := 0 to (Depth-1) do
   xAlpha[y] := Round(Start + (255 - Start)*y/(Depth-1));

  // pre-calc bg color
  sR := GetRValue(Col);
  sG := GetGValue(Col);
  sB := GetBValue(Col);

  // offsets
  w := b.Width-Depth;
  h := b.Height-Depth;

  for i := 0 to (Depth-1) do begin
    a  := xAlpha[i] / 255;
    a2 := (255 - xAlpha[i]) / 255;
    r1 := sR * a;
    g1 := sG * a;
    b1 := sB * a;
    Lx  := (Depth-1)-i;
    Lx2 := i+w;
    for y := 0 to b.Height - 1 do begin
      AlphaBlendPixel(Lx, y); // Left
      AlphaBlendPixel(Lx2, y); // right
    end;
  end;

  for i := 0 to (Depth-1) do begin
    AlphaBlendRow((Depth-1)-i, xAlpha[i]); // top
    AlphaBlendRow(i+(h), xAlpha[i]); // bottom
  end;

  SetLength(xAlpha,0);
  SetLength(pArrays,0);
end;

Final result: (left = original, right = blended on hovering with a ListView)

edit: further speed improvements, twice as fast as original proc.

Answer 1

I can give you some code I wrote a couple of years ago to achieve this. It might be useful as a guide. The code is part of a class that manipulates a bitmap and this is the part that fades the left edge of the bitmap into a white background:

procedure TScreenShotEnhancer.FadeOutLeft(Position, Start: Integer);
var
  X, Y: Integer;
  F, N: Integer;
  I: Integer;
begin
  BeginUpdate;
  try
    N := Position;
    for I := 0 to N - 1 do begin
      X := Position - I - 1;
      F := Round(Start + (255 - Start)*I/N);
      for Y := 0 to Height - 1 do
        AlphaBlendPixel(X, Y, clWhite, F);
    end;
  finally
    EndUpdate;
  end;
end;

The actual work is done in this method:

procedure TScreenShotEnhancer.AlphaBlendPixel(X, Y: Integer; Color: TColor;
    Alpha: Byte);

var
  backgroundColor: TColor;
  displayColor: TColor;
  dR, dG, dB: Byte;
  bR, bG, bB: Byte;
  sR, sG, sB: Byte;
begin
  backgroundColor := Bitmap.Canvas.Pixels[X, Y];
  bR := GetRValue(backgroundColor);
  bG := GetGValue(backgroundColor);
  bB := GetBValue(backgroundColor);
  sR := GetRValue(Color);
  sG := GetGValue(Color);
  sB := GetBValue(Color);

  dR := Round(sR * alpha / 255 + bR * (255 - alpha) / 255);
  dG := Round(sG * alpha / 255 + bG * (255 - alpha) / 255);
  dB := Round(sB * alpha / 255 + bB * (255 - alpha) / 255);
  displayColor := RGB(dR, dG, dB);
  Bitmap.Canvas.Pixels[X, Y] := displayColor;
end;