Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to make alpha transparent TImage in Delphi?

On the Form I have two TImages. TImage which is on the top should be transparent, so we can see what is underneath. How to change the level of TImage transparency?

Example: enter image description here

like image 552
Srdjan Vukmirica Avatar asked Dec 05 '13 21:12

Srdjan Vukmirica


1 Answers

The usual way would be drawing all graphics to one destination canvas (which could be the bitmap of an TImage), but even with many overlapping TImages this can be done. Be aware that you can't overlap TWinControls.
Since a 32 bit Bitmap support transparency this can be reached by converting the contained graphic to an bitmap (if needed).
By setting Alphaformat := afDefined the bitmap will be drawn with the transparency informations from the alphachannel.
We need a copy of the bitmap since setting the AlphaFormat will let us loose the pixelinformations.
Using scanlines the pixelinformation from the copy can be transferred to the destination, the alpha channel is set to the desired value.

A "fire and forget" implementation could look like this:

type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. 0] OF TRGBQuad;

procedure SetImageAlpha(Image:TImage; Alpha: Byte);
var
  pscanLine32,pscanLine32_src: pRGBQuadArray;
  nScanLineCount, nPixelCount : Integer;
  BMP1,BMP2:TBitMap;
  WasBitMap:Boolean;
begin
  if assigned(Image.Picture) then
    begin
       // check if another graphictype than an bitmap is assigned
       // don't check Assigned(Image.Picture.Bitmap) which will return always true
       // since a bitmap is created if needed and the graphic will be discared   
       WasBitMap := Not Assigned(Image.Picture.Graphic);
       if not WasBitMap then
          begin   // let's create a new bitmap from the graphic
            BMP1 := TBitMap.Create;
            BMP1.Assign(Image.Picture.Graphic);
          end
       else BMP1 := Image.Picture.Bitmap;  // take the bitmap

       BMP1.PixelFormat := pf32Bit;

       // we need a copy since setting Alphaformat:= afDefined will clear the Bitmap
       BMP2 := TBitMap.Create;
       BMP2.Assign(BMP1);

       BMP1.Alphaformat := afDefined;

    end;
    for nScanLineCount := 0 to BMP1.Height - 1 do
    begin
      pscanLine32 := BMP1.Scanline[nScanLineCount];
      pscanLine32_src := BMP2.ScanLine[nScanLineCount];
      for nPixelCount := 0 to BMP1.Width - 1 do
        begin
          pscanLine32[nPixelCount].rgbReserved := Alpha;
          pscanLine32[nPixelCount].rgbBlue := pscanLine32_src[nPixelCount].rgbBlue;
          pscanLine32[nPixelCount].rgbRed  := pscanLine32_src[nPixelCount].rgbRed;
          pscanLine32[nPixelCount].rgbGreen:= pscanLine32_src[nPixelCount].rgbGreen;
        end;
    end;
    If not WasBitMap then
      begin  // assign and free Bitmap if we had to create it
      Image.Picture.Assign(BMP1);
      BMP1.Free;
      end;
    BMP2.Free; // free the copy
end;



procedure TForm3.Button1Click(Sender: TObject);
begin  // call for the example image
  SetImageAlpha(Image1,200);
  SetImageAlpha(Image2,128);
  SetImageAlpha(Image3,80);

end;

enter image description here

like image 197
bummi Avatar answered Nov 14 '22 19:11

bummi