How to enable Alpha leveling in TImage graphic?

Question

I have TImage with a preloaded Bitmap (by PNGImage unit) with an Alpha Channel:

The subject is the Great Green Dino. I wanted to be able to change its Alpha Level in runtime, to any value in the range. Like 127 and he would look like this:

Following the answer to another similar question I almost felt in the skin it would work. But that was the result to Alpha Level 0 for example:

So, my question. Could someone know how to improve the answer's routine? Or know another way to achieve the second picture result? Note that I want to be able change this Alpha Level property in runtime be with a Method or any other way you know

Thank you in advance...

Answer 1

Using 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.
  ..

Commented a little, the above code produces the below image here (below image is the 'Image1'):

Answer 2

The other question involved using TBitmap to apply alpha blending to GIF images. TPNGImage has its own native alpha support, so you don't need to involve TBitmap. Look at the TPNGImage.CreateAlpha() method and the TPNGImage.AlphaScanline property.

Try something like this:

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;