How to remove Transparency from a TPngGraphic?

[Andrew Fiddian-Green]

Hi,

I am using the TPngGraphic (from GraphicEx) to handle 3rd party images.

Sometimes I encounter png images that have transparent "holes" in them,
and my question is how can I convert such images to fully opaque ones
without any transparency?

My code is below.

Regards,
AndrewFG

++++

fPicture := TPicture.Create;

// create a graphic of the appropriate type
if aGraphicType = jpgImage then grph := TJPEGImage.Create else
if aGraphicType = pngImage then grph := TPNGGraphic.Create else
grph := nil;

if grph <> nil then
begin

// create a memory stream
mSt := TMemoryStream.Create;
try

// set the stream size
mSt.SetSize(Length(aData));

// copy the byte array data to the stream
System.Move(aData[0], mSt.Memory^, Length(aData));

try

// load the graphic from the stream
grph.LoadFromStream(mSt);

// and assign it to the picture
fPicture.Assign(grph);

...

++++

[Jens Gruschel]

> Sometimes I encounter png images that have transparent "holes" in them,
> and my question is how can I convert such images to fully opaque ones
> without any transparency?

I think the most simple solution is to draw the png on some bitmap with
the same size. How the holes look like depends on the color (or pattern)
of this bitmap, often a completely white bitmap is used.

procedure RemoveTransparency(var Graphic: TGraphic);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf24bit;
Bitmap.Canvas.Color := clWhite;
Bitmap.Width := Graphic.Width;
Bitmap.Height := Graphic.Height;
Bitmap.Canvas.Draw(0, 0, Graphic);
Graphic.Free;
Graphic := Bitmap;
end;

not tested!

Another option is to set the alpha channel to 255 (fully opaque) for all
pixels of the png image, but the result might look different (depending
on what color the transparent pixels have).

Following code was not tested either and should only be applied to PNGs
which actually have an alpha channel (I just don't remember how to check
this right now):

procedure RemoveTransparency(var PngObject: TPngObject);
var
P: ^Byte;
X, Y: Integer;
begin
for Y := 0 to PngObject.Height - 1 do begin
P := PngObject.AlphaScanLine[Y];
for X := 0 to PngObject.Width - 1 do begin
P^ := 255;
Inc(P);
end;
end;
end;

> // create a memory stream
> mSt := TMemoryStream.Create;
> try
>
> // set the stream size
> mSt.SetSize(Length(aData));
>
> // copy the byte array data to the stream
> System.Move(aData[0], mSt.Memory^, Length(aData));

IMO that's a stupid step, copying a memory block elsewhere just to let
code capable to iterate over a memory block read it. Unfortunately
Delphi offers no better solution directly. Peter Below wrote a
ROMemStream unit / TReadOnlyMemoryStream class that addresses this
problem, maybe you can find it somewhere.

--
Jens Gruschel
http://www.pegtop.net

[Chris Rolliston]

> > // create a memory stream
> > mSt := TMemoryStream.Create;
> > try
> >
> > // set the stream size
> > mSt.SetSize(Length(aData));
> >
> > // copy the byte array data to the stream
> > System.Move(aData[0], mSt.Memory^, Length(aData));
>
> IMO that's a stupid step, copying a memory block elsewhere just to
> let code capable to iterate over a memory block read it.
> Unfortunately Delphi offers no better solution directly. Peter Below
> wrote a ROMemStream unit / TReadOnlyMemoryStream class that addresses
> this problem, maybe you can find it somewhere.

This should do for that...

type
TUserMemoryStream = class(TCustomMemoryStream)
public
function Write(const Buffer; Count: Integer): Integer; override;
end;

function TUserMemoryStream.Write(const Buffer; Count: Integer): Integer;
begin
Result := 0;
end;

...

var
mSt: TUserMemoryStream;
...
mSt := TUserMemoryStream.Create;
if Length(aData) > 0 then
mStr.SetPointer(@aData[0], Length(aData));
try
...

[Chris Rolliston]

> Another option is to set the alpha channel to 255 (fully opaque) for
> all pixels of the png image, but the result might look different
> (depending on what color the transparent pixels have).
>
> Following code was not tested either and should only be applied to
> PNGs which actually have an alpha channel (I just don't remember how
> to check this right now):

Given the original poster is using GraphicEx, this should do the trick
(your code, not wrong in itself, is for Gustavo Daud's PngImage, by the
looks of it):

procedure RemoveAlpha(Bitmap: TBitmap);
type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
var
X, Y: Integer;
Row: PRGBQuadArray;
begin
if Bitmap.PixelFormat <> pf32bit then Exit;
for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];
for X := Bitmap.Width - 1 downto 0 do
Row[X].rgbReserved := 255;
end;
end;

The TPNGGraphic of GraphicEx.pas derives from TBitmap.

[Andrew Fiddian-Green]

Jens Gruschel wrote:
> procedure RemoveTransparency(var Graphic: TGraphic);
> var
> Bitmap: TBitmap;
> begin
> Bitmap := TBitmap.Create;
> Bitmap.PixelFormat := pf24bit;
> Bitmap.Canvas.Color := clWhite;
> Bitmap.Width := Graphic.Width;
> Bitmap.Height := Graphic.Height;
> Bitmap.Canvas.Draw(0, 0, Graphic);
> Graphic.Free;
> Graphic := Bitmap;
> end;

Jens, thanks for the suggestions.

> not tested!

Indeed :-) the following line does not compile:
Bitmap.Canvas.Color := clWhite;

I tried replacing the line with the following, but it does not remove
the transparency...

Bitmap.Canvas.Brush.Color := clWhite;

Furthermore I also FloodFill, but again it does not remove the
transparency...

procedure RemoveTransparency(var Graphic: TGraphic);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf24bit;

Bitmap.Width := Graphic.Width;
Bitmap.Height := Graphic.Height;

Bitmap.Canvas.FloodFill(0, 0, clWhite, fsSurface);

Bitmap.Canvas.Draw(0, 0, Graphic);
Graphic.Free;
Graphic := Bitmap;
end;

I don't know why it fails, but I suppose that Bitmap.Canvas.Draw() is
replacing the clWhite background with its own transparency pixels ??

> procedure RemoveTransparency(var PngObject: TPngObject);

As another poster has stated, I am using TPngGraphic rather than
TPngObject, so I could not try this code.

> Peter Below wrote a
> ROMemStream unit / TReadOnlyMemoryStream class that addresses this
> problem, maybe you can find it somewhere.

Thanks for this tip. Yes I found it via Google.

AndrewFG

[Andrew Fiddian-Green]

Chris Rolliston wrote:
> procedure RemoveAlpha(Bitmap: TBitmap);
> type
> TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
> PRGBQuadArray = ^TRGBQuadArray;
> var
> X, Y: Integer;
> Row: PRGBQuadArray;
> begin
> if Bitmap.PixelFormat <> pf32bit then Exit;
> for Y := Bitmap.Height - 1 downto 0 do
> begin
> Row := Bitmap.ScanLine[Y];
> for X := Bitmap.Width - 1 downto 0 do
> Row[X].rgbReserved := 255;
> end;
> end;

Chris, thanks for the suggestion. But unfortunately it does not work
either...

[Jens Gruschel]

> Indeed :-) the following line does not compile:
> Bitmap.Canvas.Color := clWhite;

Yes, that should have been Bitmap.Canvas.Brush.Color of course :-)

> Furthermore I also FloodFill, but again it does not remove the
> transparency...

IMO a flood fill algorithm, even if it knows about transparency, is not
a good idea in this case, because it's not a general solution, except
maybe you know exactly how the graphic does look like.

> I don't know why it fails, but I suppose that Bitmap.Canvas.Draw() is
> replacing the clWhite background with its own transparency pixels ??

What do the transparent pixels look like after the Draw operation (I
mean the resulting bitmap of course, not the original PNG image)?

[Andrew Fiddian-Green]

Jens Gruschel wrote:
>> I don't know why it fails, but I suppose that Bitmap.Canvas.Draw() is
>> replacing the clWhite background with its own transparency pixels ??
>
> What do the transparent pixels look like after the Draw operation (I
> mean the resulting bitmap of course, not the original PNG image)?

Well, I assign the Graphic to a TPicture and then to a TImage on a
TForm, and basically it looks exactly the same regardless of whether or
not your code is called...

[Anders Isaksson]

Andrew Fiddian-Green wrote:

> Bitmap.Canvas.FloodFill(0, 0, clWhite, fsSurface);

Probably faster to just do a filled rectangle (Set .Pen.Color :=
.Brush.Color). And what about Bitmap.Brush.Style? Shouldn't that be set to
csOpaque (or whatever it's called)?

--
Anders Isaksson, Sweden
BlockCAD: http://web.telia.com/~u16122508/proglego.htm
Gallery: http://web.telia.com/~u16122508/gallery/index.htm

[Jens Gruschel]

> Well, I assign the Graphic to a TPicture and then to a TImage on a
> TForm, and basically it looks exactly the same regardless of whether or
> not your code is called...

I'm asking because maybe the code actually works, but either you are not
aware of it (because the "transparent" pixels don't look like you expect
them to look), or the operation is lost somewhere on its way to the
image control.

Then again it's also possible that the code doesn't work :-)

Could you provide a sample PNG file to the attachment newsgroup, the
result after the operation (just add a temporary SaveToFile), and a
screenshot of the image control after you assigned the result to it?

[Jens Gruschel]

> I tried replacing the line with the following, but it does not remove
> the transparency...

You are right, I made some test with GraphicEx. While the code I came up
with works for Gustavo Daud's PngImage, it doesn't work for GraphicEx,
simply because TPNGGraphic is derived from TBitmap and when drawn it
acts like an ordinary 32 bit TBitmap, ignoring the alpha channel at all.

So what you have to do is applying the blending operation yourself. I
modified Chris' code and following works with TPNGGraphic:

procedure RemoveAlpha(Bitmap: TBitmap);
type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
var
X, Y: Integer;
Row: PRGBQuadArray;
begin
if Bitmap.PixelFormat <> pf32bit then Exit;
for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];

for X := Bitmap.Width - 1 downto 0 do begin
Row[X].rgbBlue := 255 + (Row[X].rgbBlue - 255) *
Row[X].rgbReserved div 255;
Row[X].rgbGreen := 255 + (Row[X].rgbGreen - 255) *
Row[X].rgbReserved div 255;
Row[X].rgbRed := 255 + (Row[X].rgbRed - 255) * Row[X].rgbReserved
div 255;
Row[X].rgbReserved := 0;
end;
end;
end;

Above uses a white background color, but you can simply change it by
replacing the 255 by some other value for each color channel individually.

[Jens Gruschel]

Just an additional note: Instead of iterating over all pixels manually
you can use the AlphaBlend WinAPI function, something like:

procedure RemoveTransparency(var Graphic: TBitmap);
var
Bitmap: TBitmap;
BlendFunction: TBlendFunction;
begin
if Graphic.PixelFormat <> pf32bit then Exit;

Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf24bit;

Bitmap.Canvas.Brush.Color := clWhite;

Bitmap.Width := Graphic.Width;
Bitmap.Height := Graphic.Height;

BlendFunction.BlendOp := AC_SRC_OVER;
BlendFunction.BlendFlags := 0;
BlendFunction.SourceConstantAlpha := 255;
BlendFunction.AlphaFormat := AC_SRC_NO_PREMULT_ALPHA;
AlphaBlend(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,
Graphic.Canvas.Handle, 0, 0, Graphic.Width, Graphic.Height,
BlendFunction);
// Bitmap.Canvas.Draw(0, 0, Graphic);

Graphic.Free;
Graphic := Bitmap;
end;

Not sure about all the BlendFunction flags, but above worked fine for my
example application.

[Andrew Fiddian-Green]

Jens Gruschel wrote:
> Just an additional note: Instead of iterating over all pixels manually
> you can use the AlphaBlend WinAPI function, something like:

Sorry, but none of your suggestions seems to work so far.

In b.p.d.attachments I posted three files: 1) the png before any
transforamtion, 2) the bmp after version 1 of your RemoveTransparency(),
and 3) how the image looks on my form versus how it looks in Windows
Explorer.

Hope this helps...

[Chris Rolliston]

> Chris, thanks for the suggestion. But unfortunately it does not work
> either...

Urgh, sorry. I meant this:

procedure RemoveAlpha(Bitmap: TBitmap);
type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
var
X, Y: Integer;
Row: PRGBQuadArray;
begin
if Bitmap.PixelFormat <> pf32bit then Exit;
for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];
for X := Bitmap.Width - 1 downto 0 do

if Row[X].rgbReserved <> MaxByte then
begin
Row[X].rgbBlue := MaxByte;
Row[X].rgbGreen := MaxByte;
Row[X].rgbRed := MaxByte;
Row[X].rgbReserved := MaxByte;
end;
end;
end;

This can produce ugly results though since it doesn't do any feathering.

[Chris Rolliston]

OK, slightly improved version in that you get to choose the background
colour:

procedure RemoveAlpha(Bitmap: TBitmap;
BackgroundColor: TColor);

type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
var
X, Y: Integer;
Row: PRGBQuadArray;

NewQuad: TRGBQuad;

begin
if Bitmap.PixelFormat <> pf32bit then Exit;

if BackgroundColor = clDefault then
BackgroundColor := Bitmap.TransparentColor;
BackgroundColor := ColorToRGB(BackgroundColor);
NewQuad.rgbBlue := GetBValue(BackgroundColor);
NewQuad.rgbGreen := GetGValue(BackgroundColor);
NewQuad.rgbRed := GetRValue(BackgroundColor);
NewQuad.rgbReserved := MaxByte;

for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];
for X := Bitmap.Width - 1 downto 0 do
if Row[X].rgbReserved <> MaxByte then

Row[X] := NewQuad;
end;
end;

[Chris Rolliston]

> Sorry, but none of your suggestions seems to work so far.
>
> In b.p.d.attachments I posted three files: 1) the png before any
> transforamtion, 2) the bmp after version 1 of your
> RemoveTransparency(), and 3) how the image looks on my form versus
> how it looks in Windows Explorer.
>
>
> Hope this helps...

It still might not be what you want, but I've fixed the code I posted
earlier (see my posts above).

That said, the PNG you've posted in attachments isn't actually a PNG -
its a BMP with its file extension changed (not that this should make
any difference to Jens' or my code).

[Chris Rolliston]

OK, slightly improved version in that you get to choose the background
colour:

procedure RemoveAlpha(Bitmap: TBitmap;
BackgroundColor: TColor = clDefault);

type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;
var
X, Y: Integer;
Row: PRGBQuadArray;

NewQuad: TRGBQuad;

begin
if Bitmap.PixelFormat <> pf32bit then Exit;

if BackgroundColor = clDefault then
BackgroundColor := Bitmap.TransparentColor;
BackgroundColor := ColorToRGB(BackgroundColor);
NewQuad.rgbBlue := GetBValue(BackgroundColor);
NewQuad.rgbGreen := GetGValue(BackgroundColor);
NewQuad.rgbRed := GetRValue(BackgroundColor);
NewQuad.rgbReserved := MaxByte;

for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];
for X := Bitmap.Width - 1 downto 0 do
if Row[X].rgbReserved <> MaxByte then

[Andrew Fiddian-Green]

Chris Rolliston wrote:
> It still might not be what you want, but I've fixed the code I posted
> earlier (see my posts above).

Thanks. I will give it a try

> That said, the PNG you've posted in attachments isn't actually a PNG -
> its a BMP with its file extension changed (not that this should make
> any difference to Jens' or my code).

I think I made a mistake and uploaded the wrong file; I posted another
attempt "before2.png" in b.p.d.attachments.

AndrewFG

[Chris Rolliston]

> I think I made a mistake and uploaded the wrong file; I posted
> another attempt "before2.png" in b.p.d.attachments.

Assuming that's correct, your problem isn't to do with the PNG's
in-built transparency at all, since it has none. Rather, you've set
the Transparent property of the TImage to True! Internally, this
property is mapped to the Transparent property of the held graphic; and
since TPNGGraphic has TBitmap amongst its ancestors, it takes on that
property exactly as it is implemented in TBitmap (see
TBitmap.TransparentColor in the help for details). In short, set the
Transparent property of the TImage to False, and all should be well.

[Andrew Fiddian-Green]

Chris Rolliston wrote:

> Assuming that's correct, your problem isn't to do with the PNG's
> in-built transparency at all, since it has none. Rather, you've set
> the Transparent property of the TImage to True! Internally, this
> property is mapped to the Transparent property of the held graphic; and
> since TPNGGraphic has TBitmap amongst its ancestors, it takes on that
> property exactly as it is implemented in TBitmap (see
> TBitmap.TransparentColor in the help for details). In short, set the
> Transparent property of the TImage to False, and all should be well.

See my other post from a few minutes ago.

Yes it is true that I have set TImage.Transparent to true. And that
setting it to false "solves" the problem....

However the TImage is just a test object for visualising the image.

But my real application is a shell extension (thumbnail image handler)
that extracts an HBITMAP from a file and returns it to the shell. So in
fact I am using HBITMAP := TBitmap.ReleaseHandle to do it. And the
problem seems to be that Windows Explorer itself displays the provided
HBITMAP using transparency in its thumbnail display pane...

[Andrew Fiddian-Green]

Jens Gruschel wrote:
> Just an additional note: Instead of iterating over all pixels manually
> you can use the AlphaBlend WinAPI function, something like:

I tried this one too, and it still did not resolve my problem.

In the meantime I also encountered a similar problem with a JPEG so
perhaps my difficulty is finally NOT due to the PNG alpha channel, but
due to something else?

What I am doing is the following:

Step 1
------
Depending on the data type of the source stream create either a
TJpegImage or a TPngGraphic

grph := TJpegImage.Create;
or
grph := TPngGraphic.Create;

Step 2
------
Load the respective graphic from the source stream

grph.LoadFromStream()

Step 3
------
Create a TPicture as a holding container

fPicture := TPicture.Create;
fPicture.Graphic := grph;

Step 4
------
Create a small size thumbnail

thumb := TBitmap.Create;
thumb.Canvas.StretchDraw(.. grph);

Step 5
------
Assign the thumbnail to a TImage on my form

MyForm.Image1.Picture.Bitmap.Handle := thumb.ReleaseHandle;

Given that the problem is perhaps not due to the PNG alpha channel, the
only other areas where I can imagine problems are Step 4 and Step 5

Any further thoughts?

AndrewFG

[Chris Rolliston]

> Yes it is true that I have set TImage.Transparent to true. And that
> setting it to false "solves" the problem....

It solves the problem given how you introduced it up until now, scare
quotes or no scare quotes.

> But my real application is a shell extension (thumbnail image
> handler) that extracts an HBITMAP from a file and returns it to the
> shell. So in fact I am using HBITMAP := TBitmap.ReleaseHandle to do
> it. And the problem seems to be that Windows Explorer itself displays
> the provided HBITMAP using transparency in its thumbnail display
> pane...

Why didn't you say that in the first place? Your problem can't have
anything to do with the VCL's transparency code. In fact, I don't now
follow why Jens' initial effort failed to work, since that was
returning a 24 bit bitmap, which by definition has no alpha channel and
so no transparency from the API's point of view. Were you only testing
against TImage perhaps...? If you did test it properly against the
shell and it didn't work at all though, then perhaps the shell requires
a 32 bit bitmap (the docs for IThumbnailProvider say it does):

type
TRGBQuadArray = array[0..MaxInt div 4 - 1] of TRGBQuad;
PRGBQuadArray = ^TRGBQuadArray;

function CreateOpaque32bitHBITMAP(Graphic: TGraphic;
BkColor: TColor = clDefault): HBITMAP;
var
Bitmap: TBitmap;

X, Y: Integer;
Row: PRGBQuadArray;
begin

if BkColor = clDefault then
if Graphic is TBitmap then
BkColor := TBitmap(Graphic).TransparentColor
else
BkColor := clWhite;
Bitmap := TBitmap.Create;
try
Bitmap.Canvas.Brush.Color := BkColor;
Bitmap.PixelFormat := pf32bit;
Bitmap.SetSize(Graphic.Width, Graphic.Height);
Bitmap.Canvas.Draw(0, 0, Graphic);

for Y := Bitmap.Height - 1 downto 0 do
begin
Row := Bitmap.ScanLine[Y];
for X := Bitmap.Width - 1 downto 0 do

Row[X].rgbReserved := 255; //VCL initialises this to 0
end;
Result := Bitmap.ReleaseHandle;
finally
Bitmap.Free;
end;
end;

[Jens Gruschel]

> Well, I assign the Graphic to a TPicture and then to a TImage on a
> TForm, and basically it looks exactly the same regardless of whether or
> not your code is called...

See my answer to your post in b.p.attachments