Recent

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.Masked := True;
    Imagem.Mask(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

  • Administrator
  • 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
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
    • Nxpascal home
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, FPReadPNG

procedure 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;
  22.     b.Canvas.TextOut(10,10,'test2'); //your Text
  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;
  35.     b.LoadFromIntfImage(t);
  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;
type TReadKlas = class of TFPCustomImageReader;
var
  image: TFPCustomImage;
  Ireader: TFPCustomImageReader;
  IWriter: TFPWriterPNG;
  Reader : TReadKlas;
  ex : string;
  MM : TMemoryStream;
  OK,Transp : Boolean;
  x,y : integer;
  BLO : Word;
begin
  Image := TFPMemoryImage.Create(8, 8);
  EX:=ExtractFileExt(filspec);
  if leftstr(ex,1)='.' then delete(ex,1,1);
  ex:=upcase(EX);

  if ex='BMP' then reader:=TFPReaderBMP else
  if ex='GIF' then reader:=TFPReaderGIF else
  if (ex='JPG') OR (Ex='JPEG') then reader:=TFPReaderJPEG else
  if ex='PCX' then reader:=TFPReaderPCX else
  if ex='PNG' then reader:=TFPReaderPNG else
  if ex='PNM' then reader:=TFPReaderPNM else
  if ex='PSD' then reader:=TFPReaderPSD else
  if (ex='TGA') OR (Ex='TARGA') then reader:=TFPReaderTarga else
  if (ex='TIFF') OR (ex='TIF') then reader:=TFPReaderTIFF else
  if ex='XPM' then reader:=TFPReaderXPM else
  if ex='XWD' then reader:=TFPReaderXWD else
  exit;

  IReader:=Reader.Create;

  MM:=TMemoryStream.Create; OK:=FALSE;
  try
    MM.writeBuffer(Bla[1],length(Bla));
    MM.Position:=0;
    Image.LoadFromStream(MM,IReader);
    OK:=TRUE;
  except
    on E:Exception do writeln(E.Message);
  end;
  MM.Free;
  iReader.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!
  22.     B.Canvas.TextOut(1,1,'test10'); ///your Text
  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.  
  36.     B.LoadFromIntfImage(T);
  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;
  38.     CY.LoadFromIntfImage(Intf);
  39.  
  40.     Canvas.Draw(510,10,CY);
  41.     CY.SaveToFile('pruebaPNG.png');
  42.   finally
  43.     CY.Free;
  44.     Intf.Free;
  45.   end;
  46. end;    

 

TinyPortal © 2005-2018