如何在TImage图形中启用Alpha水平调整？

Question

我有TImage预先加载的位图（PNGImage单位）和Alpha通道：

主题是Great Green Dino。我希望能够在运行时将Alpha Level更改为该范围内的任何值。像127一样，他看起来像这样：

根据another similar question的回答，我几乎感觉皮肤会起作用。但这是Alpha Level 0的结果，例如：

所以，我的问题。有人可以知道如何改善答案的常规吗？或者知道另一种方法来实现第二张图片的结果？请注意，我希望能够在运行时使用Method或您知道的任何其他方式更改此Alpha Level属性

提前谢谢你......

Answer 1

使用AlphaBlend，

var
  Png: TPngImage;
  Bmp: TBitmap;
  BlendFn: TBlendFunction;
begin

  // suppose you already have a master png
  Png := TPngImage.Create;
  Png.LoadFromFile(
      ExtractFilePath(Application.ExeName) + '\..\..\Attention_128.png');

  // construct a temporary bitmap with the image
  Bmp := TBitmap.Create;
  Bmp.Assign(Png);

  // prepare TImage for accepting a partial transparent image
  Image1.Picture.Bitmap.PixelFormat := pf32bit;
  Image1.Picture.Bitmap.AlphaFormat := afPremultiplied;
  Image1.Picture.Bitmap.Canvas.Brush.Color := clBlack;
  Image1.Picture.Bitmap.SetSize(Png.Width, Png.Height);

  // alpha blend the temporary bitmap to the bitmap of the image
  BlendFn.BlendOp := AC_SRC_OVER;
  BlendFn.BlendFlags := 0;
  BlendFn.SourceConstantAlpha := 128;  // set opacity here
  BlendFn.AlphaFormat := AC_SRC_ALPHA;

  winapi.windows.AlphaBlend(Image1.Picture.Bitmap.Canvas.Handle,
    0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height,
    Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, BlendFn);

  // free temporary bitmap, etc.
  ..

稍微评论一下，上面的代码在这里生成下面的图像（下面的图像是'Image1'）：

Answer 2

另一个问题涉及使用TBitmap将Alpha混合应用于GIF图像。 TPNGImage有自己的原生Alpha支持，因此您无需涉及TBitmap。查看TPNGImage.CreateAlpha()方法和TPNGImage.AlphaScanline属性。

尝试这样的事情：

procedure SetPNGAlpha(PNG: TPNGImage; Alpha: Byte);
var
  pScanline: pByteArray;
  nScanLineCount, nPixelCount : Integer;
begin
  if Alpha = 255 then begin
    PNG.RemoveTransparency;
  end else
  begin
    PNG.CreateAlpha;

    for nScanLineCount := 0 to PNG.Height - 1 do
    begin
      pScanline := PNG.AlphaScanline[nScanLineCount];
      for nPixelCount := 0 to Image.Width - 1 do
        pScanline[nPixelCount] := Alpha;
    end;
  end;

  PNG.Modified := True;
end;

procedure SetBMPAlpha(BMP: TBitmap; Alpha: Byte);
type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;
var
  pScanLine32_src, pScanLine32_dst: pRGBQuadArray;
  nScanLineCount, nPixelCount : Integer;
  Tmp: TBitmap;
begin
  BMP.PixelFormat := pf32Bit;

  Tmp := TBitmap.Create;
  try
    Tmp.SetSize(BMP.Width, BMP.Height);
    Tmp.AlphaFormat := afDefined;

    for nScanLineCount := 0 to BMP.Height - 1 do
    begin
      pScanLine32_src := BMP.ScanLine[nScanLineCount];
      pScanLine32_dst := Tmp.Scanline[nScanLineCount];
      for nPixelCount := 0 to BMP.Width - 1 do
      begin
        pScanLine32_dst[nPixelCount].rgbReserved := Alpha;
        pScanLine32_dst[nPixelCount].rgbBlue := pScanLine32_src[nPixelCount].rgbBlue;
        pScanLine32_dst[nPixelCount].rgbRed  := pScanLine32_src[nPixelCount].rgbRed;
        pScanLine32_dst[nPixelCount].rgbGreen:= pScanLine32_src[nPixelCount].rgbGreen;
      end;
    end;

    BMP.Assign(Tmp);
  finally
    Tmp.Free;
  end;
end;

procedure SetImageAlpha(Image: TImage; Alpha: Byte);
var
  Tmp: TBitmap;
begin
  if Image.Picture.Graphic is TPNGImage then
    SetPNGAlpha(TPNGImage(Image.Picture.Graphic), Alpha)

  else if (not Assigned(Image.Picture.Graphic)) or (Image.Picture.Graphic is TBitmap) then
    SetBMPAlpha(Image.Picture.Bitmap, Alpha)

  else
  begin
    Tmp := TBitmap.Create;
    try
      Tmp.Assign(Image.Picture.Graphic);
      SetBMPAlpha(Tmp, Alpha);
      Image.Picture.Assign(Tmp);
    finally
      Tmp.Free;
    end;
  end;
end;