How to enable Alpha leveling in TImage graphic?

1
votes

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

enter image description here

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:

enter image description here

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:

enter image description here

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

2
delphipngtransparencydelphi-xe3alpha-transparency
What you need to do is to keep each image in a separate bitmap. Think of these bitmaps as layers. Then compose them with appropriate alpha levels into a flattened image that is drawn on the screen. I see no use for TImage here. – David Heffernan
How can I show a Bitmap on the screen whitout TImage or derived component? (except by Form.Canvas.Draw) What do you mean with "compose them"? – Guill
The exact way I told you in my last answer. The answer that you did not like. – David Heffernan
@David, see... It is imprevisible what my user will want to do with images in this form. To handle messages to paint them all at a time, in my case would never fit. If you mean to handle a message that would help me to control each single bitmap's transparency then, go on. – Guill
Well, I think I've been right all along. But I'm not going to spend significant effort here because you keep telling me that you know better. Maybe you do, but from that starting point, it's not likely to be very fruitful is it. – David Heffernan

2 Answers

5
votes

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'): enter image description here

4
votes

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;