### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: How to make a PNG with text and transparency;  (Read 14518 times)

#### everton

• Jr. Member
• Posts: 89
##### How to make a PNG with text and transparency;
« on: December 11, 2011, 09:31:47 pm »
I'm doing:

try
Imagem := TPortableNetworkGraphic.Create;

Imagem.SetSize(Imagem.Canvas.TextWidth(Text), Imagem.Canvas.TextHeight(Text));
Imagem.Canvas.Brush.Color := clSilver;

Imagem.Canvas.TextOut(0,0, Text);

Imagem.Transparent := True;
Imagem.TransparentColor := Imagem.Canvas.Brush.Color;

Imagem.SaveToFile(Arquivo);
finally
Imagem.Free;
end;

But doesn't work, doesn't make the transparency.

Anyone knows how to do that.

#### felipemdc

• Hero Member
• Posts: 3541
##### Re: How to make a PNG with text and transparency;
« Reply #1 on: December 11, 2011, 09:40:55 pm »
Try fcl-image directly to see if the writer is correct. A Tutorial about how to use fcl-image is here: http://wiki.lazarus.freepascal.org/fcl-image

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #2 on: December 11, 2011, 10:19:06 pm »
Using the fcl-image:

var
Pintura : TFPCustomCanvas;
Image : TFPCustomImage;
Writer : TFPCustomImageWriter;
begin
Image := TFPMemoryImage.Create(100,100);
Pintura := TFPImageCanvas.Create(Image);
Writer := TFPWriterPNG.Create;
Pintura.Brush.FPColor:=colTransparent;
Pintura.Brush.Style:=bsSolid;
Pintura.Rectangle(0,0,Image.Width,Image.Height);
Pintura.Pen.FPColor := colAqua;
Pintura.Pen.Style:=psSolid;
Pintura.Ellipse(10,10, 90,90);
Image.SaveToFile('DrawTest.png', Writer);
Pintura.Free;
Image.Free;
Writer.Free;
end;

Doen't work either. The background become black insted of transparent.

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #3 on: December 11, 2011, 10:20:23 pm »
Something is missing to do that, or the component is with some problem.

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #4 on: December 11, 2011, 10:24:29 pm »
I've change the Writer : TFPCustomImageWriter; to TFPWriterPNG; and doesn't work either.
Same problem: black insted of transparent.

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #5 on: December 11, 2011, 10:28:13 pm »
Someone knows how to make any of this two options work?

#### lainz

• Guest
##### Re: How to make a PNG with text and transparency;
« Reply #6 on: December 11, 2011, 11:33:00 pm »
use BGRABitmap is easy..

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #7 on: December 11, 2011, 11:34:05 pm »
I need to make an PNG to put on web.

#### Troodon

• Sr. Member
• Posts: 484
##### Re: How to make a PNG with text and transparency;
« Reply #8 on: December 12, 2011, 01:20:36 am »
Lazarus/FPC on Linux

#### everton

• Jr. Member
• Posts: 89
##### Re: How to make a PNG with text and transparency;
« Reply #9 on: December 12, 2011, 02:59:25 am »
It's make PNGs files i'll try to use it.

#### User137

• Hero Member
• Posts: 1791
##### Re: How to make a PNG with text and transparency;
« Reply #10 on: December 12, 2011, 04:13:54 am »
I was curious myself too so tested a bit with your code. I also was not able to save alpha channel. I figured, if TFPMemoryImage.Create is unable to initialize as transparent, then only choice is to load a transparent image as a base. And i made one with Gimp (attached 100x100 full transparent png). But still, even when i removed all canvas code and simply load and save it again, it becomes black...

Code: [Select]
`// uses FPImage, FPCanvas, FPImgCanv, FPWritePNG, FPReadPNGprocedure TForm1.Button1Click(Sender: TObject);var  Image : TFPCustomImage;  Writer : TFPCustomImageWriter;  reader: TFPCustomImageReader;begin  Image := TFPMemoryImage.Create(100, 100);  reader:=TFPReaderPNG.create;  Image.LoadFromFile('empty.png', reader);  Writer := TFPWriterPNG.Create;  //TFPWriterPNG(Writer).UseAlpha:=true; // SIGSEGV if uncommented  Image.SaveToFile('DrawTest.png', Writer);  Image.Free;  Writer.Free;end;`
Also, my loading code must be wrong somehow. "Create(100, 100)" <-- this kind of code should be irrelevant because loader should make the image as big or small as it loads from file. Loader may not know image's size beforehand.

edited: This however works:
Code: [Select]
`procedure TForm1.Button1Click(Sender: TObject);var pic: TPicture;begin  pic:=TPicture.Create;  pic.LoadFromFile('empty.png');  with pic.PNG.Canvas do begin    brush.Style:=bsClear;    font.Color:=clRed;    TextOut(10,10,'test');  end;  pic.SaveToFile('DrawTest.png');  pic.Free;end;`
« Last Edit: December 12, 2011, 04:37:28 am by User137 »

#### theo

• Global Moderator
• Hero Member
• Posts: 1891
##### Re: How to make a PNG with text and transparency;
« Reply #11 on: December 12, 2011, 11:42:11 am »
This works here without external libs:

Code: Text  [Select][+][-]
1. uses IntfGraphics, FPimage;
2.
3. {\$R *.lfm}
4.
5. { TForm1 }
6.
7. procedure TForm1.Button1Click(Sender: TObject);
8. var
9.   b: TPortableNetworkGraphic;
10.   t: TLazIntfImage;
11.   col:TFPColor;
12.   i,j:integer;
13. begin
14.   b := TPortableNetworkGraphic.Create;
15.   try
16.     b.PixelFormat:=pf32bit;
17.     b.SetSize(100,100);
18.     b.Canvas.Brush.Color:=clWhite;  //do not change
19.     b.Canvas.FillRect(Rect(0,0,b.Width,b.Height));
20.     b.Canvas.Font.Color:=clBlack; //do not change
21.     b.Canvas.Font.Size:=18;
23.     t := b.CreateIntfImage;
24.     for i:=0 to t.Width-1 do
25.       for j:=0 to t.Height-1 do
26.         if t.Colors[i,j].Red<>High(Word) then
27.         begin
28.           col:=t.Colors[i,j];
29.           col.alpha:=High(Word)-col.Red;
30.           col.red:=High(Word); //Producdes red text
31.           col.green:=0;
32.           col.blue:=0;
33.           t.Colors[i,j]:=col;
34.         end else t.Colors[i,j]:=colTransparent;
36.     b.SaveToFile('/home/theo/test.png');
37.   finally
38.     t.Free;
39.     b.Free;
40.   end;
41. end;
42.

#### DtC17

• New Member
• Posts: 13
##### Re: How to make a PNG with text and transparency;
« Reply #12 on: January 23, 2014, 11:44:10 pm »
Yeah, I know I'm kind of late to the party, but it might help somebody out eventually... In fact I was looking for an answer, stumbled upon this question, wasn't very satisfied and then whipped up this hunk o' junk.

Key ingredient here is to configure the FPWriter before actually using it: you have to specify you want the alpha channel.
Code to determine if there IS an alpha channel could use some work I believe-- I haven't yet found a graceful way to do it except checking if it's in use or not. This does the trick, using FPimage:

procedure Rommel;
var
image: TFPCustomImage;
IWriter: TFPWriterPNG;
ex : string;
MM : TMemoryStream;
OK,Transp : Boolean;
x,y : integer;
BLO : Word;
begin
Image := TFPMemoryImage.Create(8, ;
EX:=ExtractFileExt(filspec);
if leftstr(ex,1)='.' then delete(ex,1,1);
ex:=upcase(EX);

exit;

MM:=TMemoryStream.Create; OK:=FALSE;
try
MM.writeBuffer(Bla[1],length(Bla));
MM.Position:=0;
OK:=TRUE;
except
on E:Exception do writeln(E.Message);
end;
MM.Free;

BLO:=224 SHL 8;
if OK then begin
Transp:=FALSE;
y:=0; while (y<image.height) AND NOT(Transp) do begin
x:=0; while x<image.width do begin
if image.Colors[x,y].alpha<BLO then begin Transp:=TRUE; break; end;
inc(x);
end;
inc(y);
end;
if transp then writeln('Image has transparency.') else writeln('Image is solid.');
writeln(inttostr(image.Width)+' x '+inttostr(image.height));
IWriter := TFPWriterPNG.Create;
IWriter.UseAlpha:=Transp;
IWRiter.CompressionLevel:=clMax;
Image.SaveToFile('C:\BROL.PNG',IWriter);
IWriter.Free;
end;

image.Free;
end;

#### apexcol

• Jr. Member
• Posts: 54
##### Re: How to make a PNG with text and transparency;
« Reply #13 on: December 16, 2017, 08:51:56 am »
Better later than never!!!

So many options to draw with transparency, I used a code above and modified it so it works fine...

Code: Pascal  [Select][+][-]
1. uses IntfGraphics, FPimage;
2.
3. {\$R *.lfm}
4.
5. { TForm1 }
6.
7. procedure TForm1.Button4Click(Sender: TObject);
8. var
9.   B: TFPImageBitmap;//TPortableNetworkGraphic;
10.   T: TLazIntfImage;
11.   I, J:integer;
12.
13. begin
14.   B := TPortableNetworkGraphic.Create;
15.   try
16.     B.PixelFormat:=pf32bit;
17.     B.SetSize(300,400);
18.
19.     B.Canvas.Font.Color := clRed;  /// this is= A:\$0 Blue:\$0 Green:\$0 Red:\$FF but it has no Alpha!!! ;)
20.     B.Canvas.Font.Size:=48;
21.     B.Canvas.Brush.Style := bsClear;  /// very important!
23.
24.     T := B.CreateIntfImage;   /// fills T with zeroes with the same size as B and passes B into T
25.
26.     for I:= 0 to pred(b.Width) do   /// Draws a bar...
27.       for J:= 1 to 15 do
28.         T.TColors[I, J] := \$AA005566;
29.     T.TColors[10, 10] := \$33AA0033;  // Only a checking dot notation ABGR
30.
31.     for I:=0 to pred(t.Width) do
32.       for J:=0 to pred(t.Height) do
33.         if T.TColors[I, J] > 0 then  /// it is supposed that T is mostly filled now with A:\$0 Blue:\$0 Green:\$0 Red:\$0
34.            T.TColors[I, J] := T.TColors[I, J] + \$FF000000; /// AlphaVille!
35.
37.     Canvas.Draw(500, 0, B);  /// Paints on the form to check if it's the same as the saved one
38.     B.SaveToFile('c:\testfromLaz.png');
39.   finally
40.     FreeAndNil(T);
41.     FreeAndNil(B);
42.   end;
43. end;
« Last Edit: December 16, 2017, 08:56:56 am by apexcol »

#### apexcol

• Jr. Member
• Posts: 54
##### Re: How to make a PNG with text and transparency;
« Reply #14 on: December 18, 2017, 01:06:54 am »
A more clean example can be this!

Code: Pascal  [Select][+][-]
1. procedure TForm1.Button5Click(Sender: TObject);
2. var
3.   CY: TFPImageBitmap;
4.   i, j: Integer;
5.   Intf: TLazIntfImage;
6. begin
7.   CY := TPNGImage.Create;
8.   CY.PixelFormat := pf32bit;
9.   CY.Canvas.Brush.FPColor:=colTransparent;
10.   CY.SetSize(300,300);
11.   CY.Canvas.FillRect(0,0,CY.Width-1,CY.Height-1);
12.   try
13.     CY.Canvas.Brush.Style := bsClear;
14.     CY.Canvas.Pen.FPColor := ColRed;
15.     CY.Canvas.Pen.Width := 10;
16.     CY.Canvas.Ellipse(10,10,100,100);
17.     with CY.Canvas.Font do begin
18.         FPColor := ColBlue;
19.         PixelsPerInch := 300; /// always before height!
20.         Height := 32;
21.         Orientation := 1800;  /// inverse
22.         Name := 'PlayBill';
23.         Quality := fqCleartypeNatural;
24.     end;
25.
26.     CY.Canvas.Brush.Style := bsImage;
27.     CY.Canvas.TextOut(230,230,'EDGAR RULES!');
28.
29.     /// The plain bitmap has no Alpha, so we have to create an IntfImage, which passes the
30.     /// actual Canvas into an ABGR format that we control with TColors property.  After putting
31.     /// to all the painted things the \$FF on the Alpha position, we pass it back to the CY.Canvas
32.
33.     Intf:=CY.CreateIntfImage;
34.     for i:=0 to pred(CY.Width) do
35.       for j:=0 to pred(CY.Height) do
36.         if Intf.TColors[i,j] > 0 then
37.           Intf.TColors[i,j]:=Intf.TColors[i,j] or \$FF000000;