Delphi TBitMap transparency from ImageList to a button - delphi

I am trying to create a custom icon button with a transparent bitmap image, below the code.
The icon is stored in an ImageList connected to an ActionList.
bitmap := TBitmap.Create;
BmpObj := TMemoryStream.Create;
try
ImageList.GetBitmap(ActionList.Actions[i].ImageIndex, bitmap);
bitmap.Transparent := TRUE;
bitmap.TransparentColor := clWhite;
bitmap.Canvas.Brush.Color := clWhite;
bitmap.SaveToStream(BmpObj);
finally
BmpObj.Free;
bitmap.Free;
end;
I don't know what I am missing.. Anyone has an idea about this problem?

Without better knowledge about the components I asked about, I show the basic way of having transparent image on many Windows controls.
Take a TImageList and fill it with the images you want to use. The lower left pixel determines the transparent color. In my example black numbers are placed on white background.
On the button, set property Images to your ImageList and ImageIndex to a valid image number (0 .. ). The image will appear on the button, with the white colored areas transparent.
In the image below, I include a TImage with the bitmap so you can see the actual colors.
Note no code required.

Related

Delphi: PNG in ImageList, change color while keep alpha

Delphi.
I have an ImageList (either TImageList, or DevExpress's TcxImageList) that contains PNG pictures using alpha channel. The RGB part of the picture is a black square. The alpha channel contains the shape of the real picture. I want to change the colour of the black square, while keep the shape in the alpha channel. (So eventually i change the colour of the picture-shape-icon-whatever.)
I tried many ways, without success. I tried to change the properties of the lists, and export RGB and alpha separeted.
TImageList: the mask is not exported. If i do SaveToFile, it saves a 0 byte file, and Replace also says the mask's size is incorrect (0*0 px)
BMPimg := TBitmap.Create;
BMPmask := TBitmap.Create;
Try
TImageListHack(il1).GetImages(0, BMPimg, BMPmask);
BMPimg.Canvas.Brush.Color := clRed;
BMPimg.Canvas.FillRect(TRect.Create(0, 0, BMPimg.Width, BMPimg.Height));
il1.Replace(i, BMPimg, BMPmask);
End;
Finally
BMPimg.Free;
BMPmask.Free;
End;
TcxImageList: it loads picture+mask into BMPimg, and the mask is a black square instead of the shape in the BMPmask.
BMPimg := TBitmap.Create;
BMPmask := TBitmap.Create;
Try
il1.GetBitmap(i, BMPimg);
il1.GetMask(i, BMPmask);
BMPimg.Canvas.Brush.Color := clRed;
BMPimg.Canvas.FillRect(TRect.Create(0, 0, BMPimg.Width, BMPimg.Height));
il1.Replace(i, BMPimg, BMPmask);
Finally
BMPimg.Free;
BMPmask.Free;
End;
How can i change the foreground color while the keep the alpha channel in imagelist's PNG images?
Ehhhh.
I have to set manually the sizes of the BMPmask, then the mask comes right.
...
BMPmask.Width := il1.Width;
BMPmask.Height := il1.Height;
TImageListHack(il1).GetImages(0, BMPimg, BMPmask);
...

Delphi, Direct2D, TBitmap and Transparency

I'm struggling to be able to draw a TBitmap with transparency onto a TDirect2DCanvas without losing the transparency.
Having created a TBitmap which acts as the back-buffer for my drawing operation as follows:
bmp := TBitmap.Create;
bmp.Canvas.Brush.Handle := 0;
bmp.SetSize(100, 100);
bmp.Canvas.Brush.Color := clRed;
bmp.Transparent := true;
bmp.TransparentColor := clRed;
bmp.Canvas.Rectangle(bmp.Canvas.ClipRect);
bmp.Canvas.Pen.Color := clGreen;
bmp.Canvas.Ellipse(bmp.Canvas.ClipRect);
I then need to draw it onto my TDirect2DCanvas, however the following draws the TBitmap but removes all transparency - the background colour is drawn as red whereas if I just draw onto the TForm.Canvas then the background is transparent.
// Drawing onto the TDirect2DCanvas results in a red background
AEventArgs.Canvas.Draw(0, 0, bmp);
// Drawing onto the TForm.Canvas gives the correct result
Self.Canvas.Draw(0, 0, bmp);
My understanding now leads me on to ID2D1Bitmap and IWICBitmap interfaces, so, I can attempt to create an ID2D1Bitmap from the TBitmap using the following code (and assuming that the pixel format is copied across):
var
bmp : TBitmap;
temp : ID2D1Bitmap;
begin
// Code to initialize the TBitmap goes here (from above)
// Create an ID2D1Bitmap from a TBitmap
temp := AEventArgs.Canvas.CreateBitmap(bmp);
// Draw the ID2D1Bitmap onto the TDirect2DCanvas
AEventArgs.Canvas.RenderTarget.DrawBitmap(temp);
Now that I have an ID2D1Bitmap, the result is still the same - a red background with no transparency. I guess its entirely feasible that the Direct2D side of things uses a different method for transparency but looking at the propertys of the ID2D1Bitmap provides no clues.
My next guess is to go down the IWICBitmap interface.
Ultimately, my question is: is there a more straightforward or obvious thing that I've missed from the above which would allow the transparent TBitmap to be drawn onto the TDirect2DCanvas surface? Or is all this pain necessary in order to maintain the transparency?
Update
Ok, so after doing a bit more digging around, I can now convert the TBitmap to an IWICBitmap and then onto an ID2D1Bitmap however the issue still remains - transparency which is present in the TBitmap is not copied through when rendering to the TDirect2DCanvas.
// Create the IWICBitmap from the TBitmap
GetWICFactory.CreateBitmapFromHBITMAP(bmp.Handle, bmp.Palette, WICBitmapUsePremultipliedAlpha, wic);
wic.GetPixelFormat(pif);
// The PixelFormat is correct as `GUID_WICPixelFormat32bppPBGRA` which is
// B8G8R8A8_UNORM and PREMULTIPLIED
// Create the IWICFormatConverter
GetWICFactory.CreateFormatConverter(fc);
fc.Initialize(wic, GUID_WICPixelFormat32bppPBGRA, WICBitmapDitherTypeNone, nil, 0.0, WICBitmapPaletteTypeCustom);
// Now, create the ID2D1Bitmap
AEventArgs.Canvas.RenderTarget.CreateBitmapFromWicBitmap(fc, nil, temp);
temp.GetPixelFormat(fmt);
// Here, PixelFormat is correct matching the PixelFormat from the IWICBitmap
// Draw the bitmap to the Canvas
AEventArgs.Canvas.RenderTarget.DrawBitmap(temp);
And the result is still a non-transparent bitmap.
So the final thing I've looked into is the PixelFormat of the ID2D1RenderTarget which is the underlying render target of the TDirect2DCanvas.
// Create the canvas
fCanvas := TDirect2DCanvas.Create(Self.Handle);
fCanvas.RenderTarget.GetPixelFormat(pf);
// This gives me a PixelFormat of
// B8G8R8A8_UNORM but D2D1_ALPHA_MODE_IGNORE
So I'm guessing that the real issue is to do with the fact that the ID2D1RenderTarget PixelFormat is ignoring the alpha.
The real issue is not in the methods you are calling but the shear fact that in VCL application by default TBitmap uses 24bit RGB pixel format which does not have an alpha channel needed for alpha transparency.
If you want to use alpha transparency with TBitmap you first need to set its pixel format to pf32bit.
https://stackoverflow.com/a/4680460/3636228
Also don't forget to set Alpha channel to 0 for every pixel that you want it to be transparent.
You see Direct2D does not support same transparency as it is used in VCL where you can simply set the transparent color and every pixel of that specific color is simply ignored.
If you take a look at the source of TDirect2DCanvas.CreateBitmap, you'll see:
...
if (Bitmap.PixelFormat <> pf32bit) or (Bitmap.AlphaFormat = afIgnored) then
BitmapProperties.pixelFormat.alphaMode := D2D1_ALPHA_MODE_IGNORE
else
BitmapProperties.pixelFormat.alphaMode := D2D1_ALPHA_MODE_PREMULTIPLIED;
So to make it work, you have to match the conditions:
bmp.PixelFormat := pf32bit;
bmp.AlphaFormat := TAlphaFormat.afPremultiplied;
Then you have to prepare the alpha channel of every pixel. In your case, red is transparent, so you should do something like this:
for y := 0 to bmp.Height - 1 do begin
Line := bmp.Scanline[y];
for x := 0 to bmp.Width - 1 do begin
if (line[x].r =255) and (line[x].g = 0) and (line[x].b = 0) then
Line[x].A := 0
else
Line[x].A := 255;
end;
Then it comes:
temp := AEventArgs.Canvas.CreateBitmap(BMP);
AEventArgs.Canvas.RenderTarget.DrawBitmap(temp);
Took me entire weekend to figure it out myself, hope it helps you or someone else.

Delphi unexpectedly draws in Image's alpha channel

I have a TImage into which I loaded a PNG with transparency. David hinted me how to give it a bitmap to draw on:
var
Png: TPngImage;
Bmp: TBitmap;
begin
Png := TPngImage.Create;
Bmp := TBitmap.Create;
try
Png.LoadFromResourceName(HInstance, 'background');
Bmp.Assign(Png);
Image1.Picture.Assign(Bmp);
finally
Png.Free;
Bmp.Free;
end;
with Image1, Canvas do
begin
Pen.Width := 7;
Pen.Color := clBlue;
MoveTo(0, 0);
LineTo(150, 100);
end;
end;
I can draw on the image's canvas, but the color I defined for my Pen is ignored; instead all lines appear gray. I realized that I must be drawing in the alpha channel instead of the RGB channels, which I could confirm by putting another image underneath. (The gray I got is the color of the underlying TForm.)
The clock-face is opaque, and the area around it transparent which allows you to see the cityscape on the image underneath. So instead of having a blue hand on the clock the hand becomes transparent. (I extended the hand to go over the area which was already transparent, but it doesn't seem to change anything there.)
Why am I drawing in the alpha channel, and how can I make Delphi draw in the RGB channels instead?
update
I uploaded a minimal project which should allow you to reproduce the problem here.

FMX: Fill whole bitmap with a background color

I want to create a TImage component and fill the image with a background color. However my code is a bit longer than I have expected.
I have to set the width and height of bitmap.
I have to calculate the rectangle of the whole bitmap canvas.
If I remember correctly, in old Delphi versions, I can use FloodFill to fill the whole image with particular color. So I think I have definitively missed something.
Can someone figure out how to fill background color with simpler code?
Image := TImage.Create(nil);
Image.Position.X := 100;
Image.Position.Y := 100;
Image.Width := 500;
Image.Height := 500;
Image.Bitmap.Width := Trunc(Image.Width);
Image.Bitmap.Height := Trunc(Image.Height);
with Image.Bitmap.Canvas do
begin
BeginScene;
try
Fill.Color := TAlphaColors.Black;
FillRect(RectF(0, 0, Image.Bitmap.Width, Image.Bitmap.Height), 0, 0, [], 1.0);
finally
EndScene;
end;
end;
There is no FloodFill in FMX. But you can use Clear(TAlphaColors.Black); in order to fill the entire bitmap with a color.
The reason why you have to set the Bitmap dimensions is becouse the Bitmap size is not necessary the same size as TImage. You can have smaller or larger Bitmap than TImage and then use one of WrapModes to determine how will that image be rendered to TImage:
The WrapMode property should be one of the constants defined in the TImageWrapMode type:
iwOriginal: displays the image with its original dimensions.
iwFit: best fit (keeping image proportions--the ratio between the width and height) for the TImage rectangle. Default.
iwStretch: stretches the image to fill the entire rectangle of this TImage component.
iwTile: tiles the TImage image to cover the entire rectangle of the TImage component.
As for calculating rectangle for the whole bitmap. If you want your bitmap to have the same size as TImage then you can easily read TImage.ClipRect.
ClipRect is generally the rectangle which represents the inner part of the control that you are able to render on. On controls that have borders like TPanel for instance ClipRect dimensions are smaller than the whole control dimensions.
And as it was already stated by Sebastian you can quickly fill the entire Bitmap surface background with a single color by using TBitmap.Clear method.

Problem with TImage and TScrollBox

I am working with delphi.
I have one scroll box in which I am putting TImage control. Now I wanted to zoom the image rendered into TImage control. So, I am using stretchDraw method of TCanvas. My code is -
if sbZoom.Down then begin
rct := imgmain.Picture.Bitmap.Canvas.ClipRect;
rct := Rect(rct.Left * 2,rct.Top * 2,rct.Right * 2,rct.Bottom * 2);
imgmain.Picture.Bitmap.Canvas.StretchDraw(rct,imgmain.Picture.Bitmap);
imgmain.Repaint;
end;
It is correctly zooming the image, my problem is I want the size of scroll box also should be changed with zooming of image.
Also explain me parameters of Canvas.StretchDraw method. I am little confused with it.
Thank You.
You can do this quite easily without calling StretchDraw:
if Zoomed then begin
Image1.AutoSize := false;
Image1.Stretch := true;
Image1.Width := 2*Image1.Width;
Image1.Height := 2*Image1.Height;
end
else begin
Image1.Stretch := false;
Image1.AutoSize := true;
end;
AutoSize := true assures that the TImage is the same size as the picture inside. During zoom we switch AutoSize off and Stretch on, so the picture is resized to the TImage size (which is still the same here). Then we double the size of the TImage to make the zoom effect. As the TImage is now larger, the scrollbox can work properly.
Uwe Raabe is giving you the right way to do it. Here's why your way doesn't work: A scroll box will show scrollbars and help you see whole controls. In your case, it will only show scrollbars when the TImage object grows larger then the Scrollbox. The Scrollbox can't possibly know the internals of TImage so it doesn't care about TImage.Picture, it only cares about the control. And a TImage that has AutoSize = False doesn't care about it's Picture, it's size stays the same at all times.
Your code repaints the base bitmap onto itself. The problem is, the bitmap has fixed Width and Height: if you paint outside the bitmap's area you're basically silently ignored. When you're "zooming" by StretchDrawing the bitmap onto itself (and I'm surprised it worked to start with!) you're not making the bitmap larger and the stuff that doesn't fit gets silently clipped away. If you do want the internal bitmap to change size then you'll first need to create a new, larger bitmap, draw your enlarged image to the new bitmap and then assign the bitmap to your TImage. If you do this, make sure TImage.AutoSize = True.
You should set the size of the image control to the size of the bitmap.

Resources