How to make color of PNG image transparent

[widoman]

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 transparent
• When the png is created apparently the background is transparent in Microsoft Photo Editor
• When open the png in Google-earth (kml overlay) the png have black background its not transparent
• When open the png in Microsoft paint have black background
• When open the png in Microsoft Word and put over text the image its transparent
• When 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]

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]

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]

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]

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]

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

[dcelso]

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]

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]

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.

dont work, same result.
I used Draw() with GetFormImage() like you say, GetFormImage() return a Bitmap.

[widoman]

Without 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]

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

dont work, same result.

[widoman]

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

[lainz]

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]

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]

 conclusion, Lazarus can not create a transparent PNG.

I will change manually the PNG.

Thanks for your time.