3

ビットマップのエッジをグラデーションでフェードするライブラリ/コードはありますか？

このようなもの：

ここに画像の説明を入力してください

編集：最終コード

例の後にこのコードを思いついたのですが、スキャンラインで最適化した後は約10倍高速です。理想的には、代わりに32ビットビットマップを使用するように変換し、実際のアルファレイヤーを変更する必要があると思いますが、これは今のところ機能します。

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;

最終結果:(左=オリジナル、右= ListViewでホバリングするとブレンド）

ここに画像の説明を入力してください

編集：元のprocの2倍の速度で、さらに速度が向上します。

4

1 に答える 1

3

これを実現するために数年前に書いたコードをいくつか紹介できます。ガイドとして役立つかもしれません。コードはビットマップを操作するクラスの一部であり、これはビットマップの左端を白い背景にフェードする部分です。

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;

実際の作業は次のメソッドで行われます。

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;
于 2012-12-23T11:30:30.107 に答える