How to make a PNG with text and transparency;
lazarus / 39-Graphics

----------------------------------------------------------------------
everton · 2011-12-11 20:31

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 · 2011-12-11 20:40

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 · 2011-12-11 21:19

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 · 2011-12-11 21:20

Something is missing to do that, or the component is with some
problem.

----------------------------------------------------------------------
everton · 2011-12-11 21:24

I've change the Writer : TFPCustomImageWriter; to TFPWriterPNG; and
doesn't work either.
Same problem: black insted of transparent.

----------------------------------------------------------------------
everton · 2011-12-11 21:28

Someone knows how to make any of this two options work?

----------------------------------------------------------------------
lainz · 2011-12-11 22:33

use BGRABitmap is easy..

----------------------------------------------------------------------
everton · 2011-12-11 22:34

I need to make an PNG to put on web.

----------------------------------------------------------------------
Troodon · 2011-12-12 00:20

http://www.lazarus.freepascal.org/index.php?topic=9068.0

----------------------------------------------------------------------
everton · 2011-12-12 01:59

It's make PNGs files i'll try to use it.

----------------------------------------------------------------------
User137 · 2011-12-12 03:13

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;

----------------------------------------------------------------------
theo · 2011-12-12 10:42

This works here without external libs:

Code: Text  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses
IntfGraphics, FPimage; {$R *.lfm} { TForm1 } procedure
TForm1.Button1Click(Sender: TObject);var  b: TPortableNetworkGraphic; 
t: TLazIntfImage;  col:TFPColor;  i,j:integer;begin  b :=
TPortableNetworkGraphic.Create;  try    b.PixelFormat:=pf32bit;   
b.SetSize(100,100);    b.Canvas.Brush.Color:=clWhite;  //do not
change    b.Canvas.FillRect(Rect(0,0,b.Width,b.Height));   
b.Canvas.Font.Color:=clBlack; //do not change   
b.Canvas.Font.Size:=18;    b.Canvas.TextOut(10,10,'test2'); //your
Text    t := b.CreateIntfImage;    for i:=0 to t.Width-1 do      for
j:=0 to t.Height-1 do        if t.Colors[i,j].Red<>High(Word) then   
   begin          col:=t.Colors[i,j];         
col.alpha:=High(Word)-col.Red;          col.red:=High(Word);
//Producdes red text          col.green:=0;          col.blue:=0;    
    t.Colors[i,j]:=col;        end else
t.Colors[i,j]:=colTransparent;    b.LoadFromIntfImage(t);   
b.SaveToFile('/home/theo/test.png');  finally    t.Free;    b.Free; 
end;end;

----------------------------------------------------------------------
DtC17 · 2014-01-23 22:44

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, ;
  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 · 2017-12-16 07:51

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses
IntfGraphics, FPimage; {$R *.lfm} { TForm1 } procedure
TForm1.Button4Click(Sender: TObject);var  B:
TFPImageBitmap;//TPortableNetworkGraphic;  T: TLazIntfImage;  I,
J:integer; begin  B := TPortableNetworkGraphic.Create;  try   
B.PixelFormat:=pf32bit;    B.SetSize(300,400);     B.Canvas.Font.Color
:= clRed;  /// this is= A:$0 Blue:$0 Green:$0 Red:$FF but it has no
Alpha!!! ;)    B.Canvas.Font.Size:=48;    B.Canvas.Brush.Style :=
bsClear;  /// very important!    B.Canvas.TextOut(1,1,'test10');
///your Text     T := B.CreateIntfImage;   /// fills T with zeroes
with the same size as B and passes B into T     for I:= 0 to
pred(b.Width) do   /// Draws a bar...      for J:= 1 to 15 do       
T.TColors[I, J] := $AA005566;    T.TColors[10, 10] := $33AA0033;  //
Only a checking dot notation ABGR     for I:=0 to pred(t.Width) do   
 for J:=0 to pred(t.Height) do        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           T.TColors[I, J] := T.TColors[I, J] + $FF000000; ///
AlphaVille!     B.LoadFromIntfImage(T);    Canvas.Draw(500, 0, B);
 /// Paints on the form to check if it's the same as the saved one   
B.SaveToFile('c:\testfromLaz.png');  finally    FreeAndNil(T);   
FreeAndNil(B);  end;end;

----------------------------------------------------------------------
apexcol · 2017-12-18 00:06

A more clean example can be this!

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TForm1.Button5Click(Sender: TObject);var  CY: TFPImageBitmap;  i, j:
Integer;  Intf: TLazIntfImage;begin  CY := TPNGImage.Create; 
CY.PixelFormat := pf32bit;  CY.Canvas.Brush.FPColor:=colTransparent; 
CY.SetSize(300,300);  CY.Canvas.FillRect(0,0,CY.Width-1,CY.Height-1); 
try    CY.Canvas.Brush.Style := bsClear;    CY.Canvas.Pen.FPColor :=
ColRed;    CY.Canvas.Pen.Width := 10;   
CY.Canvas.Ellipse(10,10,100,100);    with CY.Canvas.Font do begin    
  FPColor := ColBlue;        PixelsPerInch := 300; /// always before
height!        Height := 32;        Orientation := 1800;  /// inverse 
      Name := 'PlayBill';        Quality := fqCleartypeNatural;   
end;     CY.Canvas.Brush.Style := bsImage;   
CY.Canvas.TextOut(230,230,'EDGAR RULES!');     /// The plain bitmap
has no Alpha, so we have to create an IntfImage, which passes the   
/// actual Canvas into an ABGR format that we control with TColors
property.  After putting    /// to all the painted things the $FF on
the Alpha position, we pass it back to the CY.Canvas    
Intf:=CY.CreateIntfImage;    for i:=0 to pred(CY.Width) do      for
j:=0 to pred(CY.Height) do        if Intf.TColors[i,j] > 0 then      
  Intf.TColors[i,j]:=Intf.TColors[i,j] or $FF000000;   
CY.LoadFromIntfImage(Intf);     Canvas.Draw(510,10,CY);   
CY.SaveToFile('pruebaPNG.png');  finally    CY.Free;    Intf.Free; 
end;end;

----------------------------------------------------------------------
jipété · 2024-05-29 07:34

Hello,

Quote from: apexcol on December 18, 2017, 01:06:54 amCode: Pascal
 [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i          
Intf.TColors[i,j]:=Intf.TColors[i,j] or $FF000000;
With Linux/Debian 64bits FCP 3.2.2 Laz 3.2 and Gtk2, that line must be
modified as
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i          
Intf.TColors[i,j]:=Intf.TColors[i,j] or integer($FF000000);
If not, you'll get a RangeCheckError...
(not tried the previous code, must be the same)

HTH,