How to make color of PNG image transparent
lazarus / 39-Graphics

----------------------------------------------------------------------
widoman · 2013-01-19 01:18

Hi,
I create a bitmap capturing the application form, the bitmap have
white background and others colors.I want to save the bitmap has png
making the white color transparentWhen the png is created apparently
the background is transparent in Microsoft Photo EditorWhen open the
png in Google-earth (kml overlay) the png have black background  its
not transparentWhen open the png in Microsoft paint have black
backgroundWhen open the png in Microsoft Word and put over text the
image its transparentWhen open the png in Microsoft Photo Editor, i
have to change the transparent color(show black) and save the image;
then when open the png in Google-earth its ok with transparent
background but some lines(clfucshia) are transparent
 I try various ways but none work, or the png have white
background(not transparent) or this last situation.
How to create a correct transparent png in Lazarus??
What its wrong?

PNG opened in applications
pnggoogleearth.png
pngphotoeditor.png

Same PNG edited manually with Microsoft Photo editor and opened in
google-earth
png2photoeditor.png
png2googleearth.png

Code: [Select]function
fmyScreen.MakeBitmap(pControl:TCustomControl):TBitmap;
var
  tmp: TBitmap;
  r: TRect;
begin
  r:= Rect(0, 0, pControl.ClientWidth, pControl.ClientHeight);
  tmp:= TBitmap.Create;
  tmp.SetSize(pControl.ClientWidth, pControl.ClientHeight);
  tmp.Canvas.CopyRect(r, pControl.Canvas, r);
  result:= tmp;
end;

procedure fmyScreen.MakePng(FileName: String; Trans: TColor);
var
  screen: TBitmap;
  c: TBGRABitmap;
  i,j: integer;
  xcolor: TBGRAPixel;
  zcolor: TFPColor;
begin
  screen := MakeBitmap(fmyScreen);//form
  xcolor:= ColorToBGRA(trans,255);
  zcolor.alpha := xcolor.alpha;
  zcolor.red := xcolor.red;
  zcolor.green := xcolor.green;
  zcolor.blue := xcolor.blue;

  c := TBGRABitmap.Create(screen);
  for i:=0 to c.Width-1 do
  begin
      for j:=0 to c.Height-1 do
      begin
        if(c.Canvas.Pixels[i,j]=Trans)then
        begin
          c.CanvasBGRA.Colors[i,j]:= zcolor;
        end;
      end;
  end;
  c.SaveToFile(FileName);
  c.free;
  screen.free;
end;

************
on button click
************
procedure fmyScreen.Button1Click(Sender: TObject);
begin
   MakePng('aa.png', clWhite);
end;

----------------------------------------------------------------------
dcelso · 2013-01-27 16:07

You can do it converting it in 32 bits and change white color for a
color with alpha channel equals to 0.
You must change bmp.pixelformat To pf32bit
and after of your copy add the next lines

Myimg :Tlazintfimage

myimg:=bmp.createlazintf

for i:=0 to bmp.width -1
 for j:=0 to bmp.height -1
    if myimg.colors[i,j]= colwhite then
       myimg.colors[i,j]:= coltransparent
Bmp.loadfrominterfaz(myimg)

NOTE: This method in linux does not work.

----------------------------------------------------------------------
widoman · 2013-01-28 23:35

dcelso, i cant make work
  the background of the png its not transparent, its black or white

Code: [Select]procedure TfGrid.CrearPng(FileName: String;
Transparencia: TColor);
var
  pantalla: TBitmap;
  c: TBGRABitmap;
  i,j: integer;
  xcolor: TBGRAPixel;
  zcolor: TFPColor;
  m1: Tlazintfimage;
begin
  pantalla := CrearBitmap(fGrid);
  m1:= pantalla.CreateIntfImage;
  xcolor:= ColorToBGRA(transparencia, 0);
  for i:=0 to m1.width -1 do
  begin
    for j:=0 to m1.height -1 do
    begin
      if(FPColorToTColor(m1.colors[i,j]) = Transparencia) then
        m1.colors[i,j]:= BGRAToFPColor(xcolor);
        //colTransparent => black background not transparent
        //BGRAToFPColor(xcolor) => white background not transparent
    end;
  end;
  pantalla.LoadFromIntfImage(m1);
  c := TBGRABitmap.Create(pantalla);
  c.SaveToFile(FileName);
end;

function TfGrid.CrearBitmap(pControl : TCustomControl):TBitmap;
var
  tmp: TBitmap;
  r: TRect;
begin
  r:= Rect(0, 0, pControl.ClientWidth, pControl.ClientHeight);
  tmp:= TBitmap.Create;
  tmp.PixelFormat := pf32bit;
  tmp.SetSize(pControl.ClientWidth, pControl.ClientHeight);
  tmp.Canvas.CopyRect(r, pControl.Canvas, r);
  result:= tmp;
end;

----------------------------------------------------------------------
circular · 2013-01-28 23:52

Try this:
Code: [Select]procedure fmyScreen.MakePng(FileName: String; Trans:
TColor);
var
  screen: TBitmap;
  c: TBGRABitmap;
  i,j: integer;
  xcolor: TBGRAPixel;
begin
  screen := MakeBitmap(fmyScreen);//form
  xcolor:= ColorToBGRA(trans,255);

  c := TBGRABitmap.Create(screen);
  screen.free;
  for i:=0 to c.Width-1 do
  begin
      for j:=0 to c.Height-1 do
      begin
        if(c.GetPixel(i,j)=xcolor)then
          c.SetPixel(i,j, BGRAPixelTransparent);
      end;
  end;
  c.SaveToFile(FileName);
  c.free;
end;

----------------------------------------------------------------------
widoman · 2013-01-29 00:55

circular,
Png created open with:
Microsoft Word 2000 => image transparent OK
Microsoft Photo Editor => some fuchsia lines changed to black, image
transparent OK
Google-earth => KML with image as overlay the image background its
black not transparent 
** image like the first example in this post

----------------------------------------------------------------------
circular · 2013-01-29 11:37

What if you do c.SetPixel(0,0,BGRAPixelTransparent) before
c.SaveToFile ?

----------------------------------------------------------------------
dcelso · 2013-01-29 12:44

Without using BGRA library would be as the next, using it, I dont
know.
Code: [Select]unit unit3;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls, IntfGraphics, FPimage;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    function CrearBitmap(pControl :
TCustomControl):TPortableNetworkGraphic;
    procedure CrearPng(FileName: String; Transparencia: TColor);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function TForm1.CrearBitmap(pControl :
TCustomControl):TPortableNetworkGraphic;
var
  tmp: TPortableNetworkGraphic;
  r: TRect;
begin
  r:= Rect(0, 0, pControl.ClientWidth, pControl.ClientHeight);
  tmp:= TPortableNetworkGraphic.Create;
  tmp.PixelFormat := pf32bit;
  tmp.SetSize(pControl.ClientWidth, pControl.ClientHeight);
  tmp.Canvas.CopyRect(r, pControl.Canvas, r);
  result:= tmp;
end;

procedure TForm1.CrearPng(FileName: String; Transparencia: TColor);
var
  pantalla: TPortableNetworkGraphic;
  m1: Tlazintfimage;
  tempcolor: TFPColor;
  i,j : Integer;
begin
  pantalla := CrearBitmap(Form1);
  m1:= pantalla.CreateIntfImage;
  for i:=0 to m1.width -1 do
    for j:=0 to m1.height -1 do
    begin
      tempcolor:=m1.colors[i,j];
      if  tempcolor= TColorToFPColor(Transparencia) then
       tempcolor.alpha:=0
      else
       tempcolor.alpha:=$FFFF;

      m1.colors[i,j]:= tempcolor; // if you want keep RGB information
   end;
  pantalla.LoadFromIntfImage(m1);
  m1.free;
  pantalla.SaveToFile(FileName);
  pantalla.free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
      CrearPng(Edit1.Text,clWhite);
end;

end.


The form example is the next:
Code: [Select]object Form1: TForm1
  Left = 292
  Height = 46
  Top = 224
  Width = 321
  Caption = 'Form1'
  ClientHeight = 46
  ClientWidth = 321
  LCLVersion = '1.1'
  object Edit1: TEdit
    Left = 16
    Height = 23
    Top = 18
    Width = 176
    Color = clWhite
    TabOrder = 0
    Text = '32bits.png'
  end
  object Button1: TButton
    Left = 216
    Height = 25
    Top = 16
    Width = 75
    Caption = 'Button1'
    OnClick = Button1Click
    TabOrder = 1
  end
end

----------------------------------------------------------------------
User137 · 2013-01-29 14:02

Code: [Select]r:= Rect(0, 0, pControl.ClientWidth,
pControl.ClientHeight);
tmp.Canvas.CopyRect(r, pControl.Canvas, r);You use CopyRect for
drawing everything. Would Draw() work? There used to be some problems
with CopyRect dealing with transparency.

----------------------------------------------------------------------
widoman · 2013-01-30 01:54

Quote from: User137 on January 29, 2013, 03:02:29 pmCode: [Select]r:=
Rect(0, 0, pControl.ClientWidth, pControl.ClientHeight);
tmp.Canvas.CopyRect(r, pControl.Canvas, r);You use CopyRect for
drawing everything. Would Draw() work? There used to be some problems
with CopyRect dealing with transparency.
 dont work, same result.
I used Draw() with GetFormImage() like you say, GetFormImage() return
a Bitmap.

----------------------------------------------------------------------
widoman · 2013-01-30 02:04

Quote from: dcelso on January 29, 2013, 01:44:05 pmWithout using BGRA
library would be as the next, using it, I dont know.
Code: [Select]function TForm1.CrearBitmap(pControl :
TCustomControl):TPortableNetworkGraphic;
begin
   //exactly like your example
end;

procedure TForm1.CrearPng(FileName: String; Transparencia: TColor);
begin
   //exactly like your example
end;
I change the functions
CrearBitmap() => use TPortableNetworkGraphic and return a PNG like you
say
CrearPng() => modify alpha and use PNG like you say
  dont work
Microsoft Word => ok image transparent
Microsoft Photo Editor => ok image transparent, some fuchsia lines
changed to white
Google-earth => show png with white background not transparent
** image like the first example in this post
** I have to edit png manually to change transparent color but some
lines dissapear because are white like background detected to make
transparent

----------------------------------------------------------------------
widoman · 2013-01-30 02:07

Quote from: circular on January 29, 2013, 12:37:03 pmWhat if you do
c.SetPixel(0,0,BGRAPixelTransparent) before c.SaveToFile ?
  dont work, same result.

----------------------------------------------------------------------
widoman · 2013-01-30 02:31

maybe the problem is the software
Lazarus 1.0.4
Rev SVN: 39422
FPC 2.6.0
Packages list

----------------------------------------------------------------------
lainz · 2013-01-30 04:06

Attach a transparent PNG not generated in lazarus that works in all
the programs you've mentioned, then maybe circular can analize it, im
wrong?

5) Paint in Windows 8 load transparent as White.. and if you save it
loses transparency. So transparency in this program is not supported.

----------------------------------------------------------------------
widoman · 2013-01-30 04:37

Example image not generated in Lazarus => 12345rq.png
its transparent in: Microsoft Word 2000, Google-earth and Microsoft
Photo Editor
* image  "12345rq.png" need to be in same place than "xyz.kml"
* open  "xyz.kml" with google-earth

Save next xml has "xyz.kml"
Code: [Select]<?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://www.opengis.net/kml/2.2"
xmlns:gx="http://www.google.com/kml/ext/2.2"
xmlns:kml="http://www.opengis.net/kml/2.2"
xmlns:atom="http://www.w3.org/2005/Atom">
<ScreenOverlay id="12345">
<name>12345rq</name>
<Icon><href>12345rq.png</href></Icon>
<overlayXY x="0.5" y="0.5" xunits="fraction" yunits="fraction"/>
<screenXY x="0.5" y="0.5" xunits="fraction" yunits="fraction"/>
<size x="0" y="0" xunits="pixels" yunits="pixels"/>
</ScreenOverlay>
</kml>

----------------------------------------------------------------------
widoman · 2013-02-05 21:48

conclusion, Lazarus can not create a transparent PNG.

I will change manually the PNG.

  Thanks for your time.

----------------------------------------------------------------------
User137 · 2013-02-05 23:13

Just tried this quickly, seems to work fine on Windows 7 32-bit, and
somewhat new Lazarus. It saves both BMP and PNG. There is clear
difference in their file size, and both show alpha channel in Gimp
too, PNG also in Windows Photo viewer and explorer.
Code: [Select]TForm1 = class(TForm)
    ..
  private
    bmp: TBitmap;
  end;
..
procedure TForm1.FormCreate(Sender: TObject);
var i, j, n: integer; data: PByte;
    pic: TPicture;
begin
  randomize;
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf32bit;
  bmp.SetSize(256, 256);
  data:=bmp.RawImage.Data;
  for i:=0 to 255 do
    for j:=0 to 255 do begin
      n:=(j*256+i)*4;
      data[n+0]:=0;   // B
      data[n+1]:=255; // G
      data[n+2]:=0;   // R
      data[n+3]:=i*2 mod 256; // A
    end;
  bmp.SaveToFile('tmp.bmp');

  pic:=TPicture.Create;
  pic.Assign(bmp);
  pic.SaveToFile('tmp.png');
  pic.Free;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  canvas.Clear;
  canvas.Draw(0, 0, bmp);
end;

----------------------------------------------------------------------
widoman · 2013-02-06 02:05

User137,   you rule man

This code work , the PNG is transparent in google-earth

THANK YOU

----------------------------------------------------------------------
widoman · 2013-02-06 03:08

Two observations
If alpha=0 in transparent color (this case clWhite)
the PNG show white background in google-earth and transparent vertical
lines (clFuchsia) in photoeditor
If alpha is not set to 255 in all others colors
the PNG its 100% transparent without pixels colored One last error
with this code
the image is cropped .. i guess "n" its wrong calculated

The final code
Code: [Select]procedure TfGrid.CrearPng(FileName: String;
Transparency: TColor);
var
  screen: TBitmap;
  pic: TPicture;
  data: PByte;
  i, j, n: integer;
begin
  screen := CrearBitmap(fGrid);
  data:= screen.RawImage.Data;
  for i:=0 to screen.Width-1 do
  begin
    for j:=0 to screen.Height-1 do
    begin
      n:=(j*screen.Height + i)*4;
      data[n+3]:= 255;//Alpha
      if(RGBToColor(data[n+2], data[n+1], data[n+0])=Transparency)then
        data[n+3]:= 1;//Alpha
    end;
  end;
  pic:=TPicture.Create;
  pic.Assign(screen);
  pic.SaveToFile(FileName);
  pic.Free;
end;

function TfGrid.CrearBitmap(pControl : TCustomControl):TBitmap;
var
  bmp: TBitmap;
  r: TRect;
begin
  r:= Rect(0, 0, pControl.ClientWidth, pControl.ClientHeight);
  bmp:= TBitmap.Create;
  bmp.PixelFormat:=pf32bit;
  bmp.SetSize(pControl.ClientWidth, pControl.ClientHeight);
  bmp.Canvas.CopyRect(r, pControl.Canvas, r);
  result:= bmp;
end;

----------------------------------------------------------------------
User137 · 2013-02-06 04:03

You should change the Fuchsia to some other color too, like black or
white. It was purple in original picture only to show clearly, but now
you want to hide it. So here:
Code: [Select]if (RGBToColor(data[n+2], data[n+1],
data[n+0])=Transparency) then begin
  data[n+0]:=0;
  data[n+1]:=0;
  data[n+2]:=0;
  data[n+3]:=1; // or 0 ...
end;

----------------------------------------------------------------------
widoman · 2013-02-06 07:26

User137,  you misunderstood what i want:
draw white filled rectangles with border clFuchsia in the formselected
rectangles will have different color (fill clLime)create bitmap
capturing the formsave bitmap has png making white color
transparentopen the png in google-earth to view has "grid" over the
map
I cant figure why the png is cropped ??
the bottom rectangles are incomplete like the image was sliced

----------------------------------------------------------------------
User137 · 2013-02-06 08:47

Wouldn't it be a Google earth image size limitation? If so, image file
itself could not change it... Can you load fullscreen non-transparent
image that goes under the cropped part?

----------------------------------------------------------------------
widoman · 2013-02-06 17:56

User137, the problem not is google-earth

The problem is in Lazarus when create PNG
bmp is 1152x808 => correct image, grid lines and white bakcground
png is 1152x808 => some grid lines disappear (transparent)

----------------------------------------------------------------------
User137 · 2013-02-06 18:30

I can't reproduce. This is 2048x2048 transparent fuschia grid between
every 100 pixels. Both bmp and png are showing fine in Gimp.
Code: [Select]procedure TForm1.FormCreate(Sender: TObject);
var i, j, n: integer; data: PByte;
    pic: TPicture;
begin
  randomize;
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf32bit;
  bmp.SetSize(2048, 2048);
  data:=bmp.RawImage.Data;
  for i:=0 to 2047 do
    for j:=0 to 2047 do begin
      n:=(j*2048+i)*4;
      if (i mod 100=0) or (j mod 100=0) then begin
        data[n+0]:=255; // B
        data[n+1]:=0;   // G
        data[n+2]:=255; // R
        data[n+3]:=255; // A
      end else begin
        data[n+0]:=255; // B
        data[n+1]:=255; // G
        data[n+2]:=255; // R
        data[n+3]:=0;   // A
      end;
    end;
  bmp.SaveToFile('d:\netti\tmp.bmp');

  pic:=TPicture.Create;
  pic.Assign(bmp);
  pic.SaveToFile('d:\netti\tmp.png');
  pic.Free;
end;By the way, such image could also be created manually using
MsPaint for grid and editing with Gimp for making it tranparent.

edit: This code could be problem:
Code: [Select]n:=(j*screen.Height + i)*4;It seems this is right, when
i tested with non square image:
Code: [Select]n:=(j*screen.Width + i)*4;

----------------------------------------------------------------------
widoman · 2013-02-06 22:30

User137, this is working THANK YOU   this is the end

Observations
The color clFuchsia for lines and clLime for selected rectangles do
not affect, i test change both colors without different resultI have
to leave 1 row without changing Alpha to work, if i dont do this the
PNG its not transparent have white backgroundLike you say "n" was
wrong calculatedI take another approach to understand the code and
manipulate "data"The final code
Code: [Select]procedure TfGrid.CrearPng(FileName: String;
Transparency: TColor);
var
  screen: TBitmap;
  pic: TPicture;
  data: PByte;
  i, j, n: integer;
begin
  screen := CrearBitmap(fGrid);
  data:= screen.RawImage.Data;
  for i:=0 to screen.Height-1 do
  begin
    for j:=0 to screen.Width-1 do
    begin
      if(i>0)then begin
        n:=(i*screen.Width + j)*4;
        data[n+3]:= 255;//Alpha
        if(RGBToColor(data[n+2], data[n+1],
data[n+0])=Transparency)then
          data[n+3]:= 1;//Alpha
      end;
    end;
  end;
  pic:=TPicture.Create;
  pic.Assign(screen);
  pic.SaveToFile(FileName);
  pic.Free;
end;