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:
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;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With