Lazarus
Programming => Graphics and Multimedia => Graphics => Topic started by: widoman on January 19, 2013, 02:18:48 am
-
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
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;
-
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. :'(
-
dcelso, i cant make work
:'( the background of the png its not transparent, its black or white
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;
-
Try this:
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;
-
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
-
What if you do c.SetPixel(0,0,BGRAPixelTransparent) before c.SaveToFile ?
-
Without using BGRA library would be as the next, using it, I dont know.
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:
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
-
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.
-
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.
-
Without using BGRA library would be as the next, using it, I dont know.
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
-
What if you do c.SetPixel(0,0,BGRAPixelTransparent) before c.SaveToFile ?
:'( dont work, same result.
-
:) maybe the problem is the software
Lazarus 1.0.4
Rev SVN: 39422
FPC 2.6.0
Packages list
-
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.
-
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"
<?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>
-
:'(conclusion, Lazarus can not create a transparent PNG.
I will change manually the PNG.
:D Thanks for your time.
-
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.
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;
-
User137, ;D you rule man
This code work :o, the PNG is transparent in google-earth
THANK YOU :D
-
::) 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
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;
-
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:
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;
-
User137, you misunderstood what i want:
- draw white filled rectangles with border clFuchsia in the form
- selected rectangles will have different color (fill clLime)
- create bitmap capturing the form
- save bitmap has png making white color transparent
- open 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
-
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?
-
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)
-
I can't reproduce. This is 2048x2048 transparent fuschia grid between every 100 pixels. Both bmp and png are showing fine in Gimp.
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:
n:=(j*screen.Height + i)*4;It seems this is right, when i tested with non square image:
n:=(j*screen.Width + i)*4;
-
User137, this is working THANK YOU ;D 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 result
- I have to leave 1 row without changing Alpha to work, if i dont do this the PNG its not transparent have white background
- Like you say "n" was wrong calculated
- I take another approach to understand the code and manipulate "data"
The final code
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;