How to make alpha transparent TImage in Delphi?

I have two TImages in the form. The TImage that is on top should be transparent, so we can see what is below. How to change the transparency level of TImage?

Example: enter image description here

+4
source share
2 answers

The usual way is to draw all the graphs on one destination canvas (this can be a TImage bitmap), but even with many overlapping TImages this can be done. Keep in mind that you cannot overlap TWinControls.
Since 32-bit support for Bitmap support can be achieved by converting the contained graphics to a bitmap (if necessary).
By setting Alphaformat: = afDefined, the bitmap will be drawn with transparency information from the alpha channel.
We need a copy of the bitmap, since installing AlphaFormat will allow us to lose pixelinformations.
Using scan lines, pixel information from the copy can be transferred to the addressee, the alpha channel is set to the desired value.

" " :

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

+9

TImage ( , ) - . - GIF TImage TGIFImage.

0

All Articles