Delphi, Direct2D, TBitmap and Transparency - delphi

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.

Related

Fast crop .png images in Delphi

I don't know what to do here anymore, so I hope that somebody can help me.
I'm using Delphi 10.4 and Windows 10.
Basically, my problem is that cutting a part of the .png image with transparent background is to slow. I use scanline.
I have one background image (back.bmp) that is drawn on the form. That image can be also a .png (with no transparency) if that can help to solve this.
From the second image (frontsigns.bmp) I cat different parts and need to draw them to that background.
Old version of this program used .bmp as second image (with no transparent background) so that was very fast.
procedure TfrmMain.btnDrawBMPClick(Sender: TObject);
var
frontsigns : TBitmap;
begin
frontsigns := TBitmap.Create;
frontsigns.LoadFromFile('E:\frontsigns.bmp');
frmMain.Canvas.CopyRect(Rect(0,0,302,869), frontsigns.Canvas, Rect(0, yStartPos, 302, yEndPos)); // yStartPos and yEndPos are variables
end;
This draw part of the second image (303x870 px) on the background in the 0.415 ms. That is OK (probably can't be faster).
Now I need to use a second image with transparent backgrounds, so I use .png. Because I cut and draw different parts of the second image on the background my idea is that I use temp background image and draw part of the .png on that temp image and after that I draw it on the form.
Here is the code.
procedure TfrmMain.btnDrawBMPClick(Sender: TObject);
var
background, tmpbackground : TBitmap;
frontsigns, CroppedPng : TPngImage;
begin
background := TBitmap.Create;
background.LoadFromFile('E:\back.bmp');
frontsigns := TPngImage.Create;
frontsigns.LoadFromFile('E:\frontsigns.png');
tmpbackground := TBitmap.Create(303, 870);
tmpbackground.Canvas.CopyRect(Rect(0, 0, 302, 869), background.Canvas, Rect(0, 0, 302, 869));
CropPng(frontsigns, 0, yStartPos, 302, yEndPos, CroppedPng); // yStartPos and yEndPos are variables
tmpbackground.Canvas.Draw(0, 0, CroppedPng);
end;
This draw part of the second image (303x870 px) on the background in the 13.5 ms!!!!!!!
Reason is slow scanline I think. I should write here that frontsigns.png has only fully transparent background. There are not any semi-transparent pixels.
Here is my code for cropping .png images.
const
ColorTabMax = 10;
ColorTab : array[0..ColorTabMax-1] of TColor =
(ClBlack, ClMaroon, ClRed, ClWebDarkOrange, ClYellow, ClGreen, ClBlue, ClPurple, ClGray, ClWhite);
procedure CropPng(Source: TPngImage; Left, Top, Width, Height: Integer; out Target : TPngImage);
function ColorToTriple(Color: TColor): TRGBTriple;
begin
Color := ColorToRGB(Color);
Result.rgbtBlue := Color shr 16 and $FF;
Result.rgbtGreen := Color shr 8 and $FF;
Result.rgbtRed := Color and $FF;
end;
var
X, Y : Integer;
Bitmap : TBitmap;
BitmapLine : PRGBLine;
AlphaLineA, AlphaLineB : pngImage.PByteArray;
begin
if (Source.Width < (Left + Width)) or (Source.Height < (Top + Height)) then
raise Exception.Create('Invalid position/size');
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.PixelFormat := pf24bit;
for Y := 0 to Bitmap.Height - 1 do
begin
BitmapLine := Bitmap.Scanline[Y];
for X := 0 to Bitmap.Width - 1 do
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
end;
Target := TPngImage.Create;
Target.Assign(Bitmap);
if Source.Header.ColorType in [COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA] then
begin
Target.CreateAlpha;
for Y := 0 to Target.Height - 1 do
begin
AlphaLineA := Source.AlphaScanline[Top + Y];
AlphaLineB := Target.AlphaScanline[Y];
for X := 0 to Target.Width - 1 do
AlphaLineB^[X] := AlphaLineA^[X + Left];
end;
end;
finally
Bitmap.Free;
end;
end;
I'm open for any ideas here. Can I make scanline works fatser? I don't have semi-transparent pixels so maybe I don't need to do all this.
I've tried with 32bit .bmp images with alpha channel, but haven't made it work with alphablend function.
I'me even open for third party libraries if there is no otehr option.
Thanks.....
In library PngComponents unit PngFunctions offers procedure SlicePNG, which allows to split a TPngImage into separate parts of equal size. As this has to be done only once it may significantly reduce the drawing time.
The problem with your approach is that you are reading your source image by accessing individual pixels using Source.Pixels and not using ScanLine
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
If you want to benefit properly by using ScanLine make sure you use ScanLine for both source and target images.
Also since your source and target images are both TPngImage you probably don't even need to create the temporary TBitmap.
And if color palettes of your PNG's match then you don't even need to do any color decoding/encoding but instead just copy data directly from one image to another. Of course you do need to make sure that color palette in your PNG's match each other in advance.
I remember reading about a tool that modifies a PNG's palette information to match with other files some years ago. Unfortunately I don't remember its name. I do remember reading about it in an article about creating of PNG based image atlases for games.
Here is my current progress thank you to the SilverWariors answer. I've just implemented first tip for now.
I was using information from:
https://delphi.cjcsoft.net/viewthread.php?tid=48996
https://en.wikipedia.org/wiki/BMP_file_format
I've replaced:
BitmapLine^[X] := ColorToTriple(Source.Pixels[Left + X, Top + Y]);
with:
BitmapLine^[X] := GetPixel(source, Left + X, Top + Y);
GetPixel function is bellow.
function GetPixel(Source: TPngImage; X, Y: Integer): TRGBTriple;
var
LineSource : pngImage.PByteArray;
begin
LineSource := Source.Scanline[y];
// Get blue value - stored in lowest order byte in a TColor
Result.rgbtBlue := PByteArray(LineSource)^[(x*3)+0];
// Get Green value - second lowest byte in TColor
Result.rgbtGreen := PByteArray(LineSource)^[(x*3)+1];
// Get Red value - third lowest byte in TColor
Result.rgbtRed := PByteArray(LineSource)^[(x*3)+2];
end;
I'm not sure why the color order is like this and not like in the article on the link above. Maybe because .png file is 32bit.
With this change I've decreased time from 13.5 ms to 6.44 ms. That is great, but I think it can be even much better.
Here is where is I see potential improvement.
Now I scan every line two times. One for the RGB colors and one for for ALPA information.
AlphaLineA := Source.AlphaScanline[Top + Y];
I think that I can get ALPHA info from scanline if I scanline returns all four bytes in a 32bit image. I'm I correct?
Maybe something like:
PByteArray(LineSource)^[(x*3)+3];
Another idea is that I can directly write to the final background. Now I cut part of the .png image and draw it on the background at the end. I must use draw because transparency that .png image that I got as result of croping original image will be lost if I use CopyRect.
But If I draw pixels directly to the background (that has ALPHA 255) that would be much faster. Maybe I can avoid that because the background is 32bit .bmp (it can be 32bit .png) without any transparency (ALPHA is 255 for all bits). Also ALPHA for .png that I'm cutting of can be only 255 (not transparent) and 0 (fully transparent).
I'm not sure how I can accomplish this.

Delphi TBitMap transparency from ImageList to a button

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.

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

How to load a transparent Image from ImageList?

I want to load a picture (32 bit-depth, transparent) from a TImageList to an TImage. The standard approach would be ImageList.GetBitmap(Index, Image.Picture.Bitmap);. However the GetBitmap method doesn't work with transparency, so I always get a non-transparent bitmap.
The workaround is rather simple - ImageList offers another method, GetIcon, which works OK with transparency. Code to load a transparent Image would be:
ImageList.GetIcon(Index, Image.Picture.Icon);
And don't forget to set proper ImageList properties:
ImageList.ColorDepth:=cd32bit;
ImageList.DrawingStyle:=dsTransparent;
I too have had various issues with passing in images from the a tImageList. So I have a simple wrapper routine that generally does the job and it enforces the transparency. The code below is Delphi 2005 and imlActiveView is the tImageList component that has my set of button glyph images.
procedure TfrmForm.LoadBitmap (Number : integer; bmp : tBitMap);
var
ActiveBitmap : TBitMap;
begin
ActiveBitmap := TBitMap.Create;
try
imlActiveView.GetBitmap (Number, ActiveBitmap);
bmp.Transparent := true;
bmp.Height := ActiveBitmap.Height;
bmp.Width := ActiveBitmap.Width;
bmp.Canvas.Draw (0, 0, ActiveBitmap);
finally
ActiveBitmap.Free;
end
end;
Here is an example of use where the 5th imlActiveView image is passed into the btnNavigate.Glyph.
LoadBitmap (5, btnNavigate.Glyph)

Resources