🚀 go-pugleaf

> 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

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

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

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

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

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


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

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

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

> 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
http://www.pegtop.net

> 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
http://www.pegtop.net

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.

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

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

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;

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

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
        Row[X] := NewQuad;
  end;
end;

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

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

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

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

> 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

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