Recent

Author Topic: Yet again transparent PNG  (Read 6638 times)

Zaher

  • Hero Member
  • *****
  • Posts: 679
    • parmaja.org
Yet again transparent PNG
« on: January 14, 2017, 02:18:09 pm »
I want to make png have text with tranpsparent background, all i got it black background, even in LazPaint it open it as black, i tried most example in the forum, but same.

I test example from wiki with some modification.

http://wiki.freepascal.org/Graphics_-_Working_with_TCanvas
Code: Pascal  [Select][+][-]
  1. procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
  2. var
  3.   w,h: integer;
  4.   IntfImg: TLazIntfImage;
  5.   Img: TPortableNetworkGraphic;
  6.   dy: Integer;
  7.   dx: Integer;
  8.   col: TFPColor;
  9.   FontColor: TColor;
  10.   c: TColor;
  11. begin
  12.   w:=0;
  13.   h:=0;
  14.   Canvas.GetTextSize(TheText,w,h);
  15.   if (w<=0) or (h<=0) then exit;
  16.   Img:=TPortableNetworkGraphic.Create;
  17.   IntfImg:=nil;
  18.   try
  19.     // paint text to a bitmap
  20.     Img.Masked:=true;
  21.     Img.SetSize(w,h);
  22.     Img.Canvas.Brush.Style:=bsSolid;
  23.     Img.Canvas.Brush.Color:=clWhite;
  24.     Img.Canvas.FillRect(0,0,w,h);
  25.     Img.Canvas.Font:=Canvas.Font;
  26.     Img.Canvas.TextOut(0,0,TheText);
  27.     // get memory image
  28.     IntfImg:=Img.CreateIntfImage;
  29.     // replace gray pixels
  30.     FontColor:=ColorToRGB(Canvas.Font.Color);
  31.     for dy:=0 to h-1 do begin
  32.       for dx:=0 to w-1 do begin
  33.         col:=IntfImg.Colors[dx,dy];
  34.         c:=FPColorToTColor(col);
  35.         if c<>FontColor then
  36.           IntfImg.Colors[dx,dy]:=colTransparent;
  37.       end;
  38.     end;
  39.     // create bitmap
  40.     Img.LoadFromIntfImage(IntfImg);
  41.     Img.Transparent := True;
  42.     Img.TransparentColor := clBlack;
  43.     Img.SaveToFile('d:\temp\myfont4.png');
  44.     // paint
  45.     Canvas.Draw(x,y,Img);
  46.   finally
  47.     IntfImg.Free;
  48.     Img.Free;
  49.   end;
  50. end;
  51.  

Any idea why i cant save as transparent file?
« Last Edit: December 24, 2019, 01:08:20 pm by Zaher »

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Yet again transparent PNG
« Reply #1 on: January 14, 2017, 02:28:52 pm »
You need to do it all yourself with the stuff that comes with lazarus or you can use another library?

Zaher

  • Hero Member
  • *****
  • Posts: 679
    • parmaja.org
Re: Yet again transparent PNG
« Reply #2 on: January 14, 2017, 05:56:06 pm »
I don't like to use external big library, if it small it is not problem
I prefer official one that come with Lazarus of Freepascal

I don't like to use bgrabitmap it is so big for my project

https://github.com/bgrabitmap/bgrabitmap/tree/master/bgrabitmap
« Last Edit: January 14, 2017, 08:11:35 pm by Zaher »

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Yet again transparent PNG
« Reply #3 on: January 14, 2017, 08:21:47 pm »
Is not that big, you only need to include two files to work with it =)

derek.john.evans

  • Guest
Re: Yet again transparent PNG
« Reply #4 on: January 14, 2017, 08:56:37 pm »
First up::: There is a difference between alpha transparent, and keycolor transparent. The Transparent/TransparentColor properties are for keycolor transparency.

Keycolor comes in 2 flavours. Runtime color lookup and "pre calculated" masks. Lazarus uses masks as apposed to DirectDraw which supports runtime color lookup.

Masked keycolor transparency pre-creates a secondary mask. The background is first AND'ed with the mask to clear bits for the bitmap. Then the bitmap is OR'ed onto the background.

Anyway  :o None of that matters, since a mask is not saved to the PNG.

You are wanting to create a 32bit BGRA transparent PNG. The problem is, the GDI (TCanvas) doesn't support 32bit.

GDI wil draw to a 32bit bitmap, but it will set the alpha to zero, effectively making your drawing transparent.

There are 3 ways to fix this.

1) Save to a 24bit image. It works, but then you loose your alpha.

2) Iterate the raw pixels and fill in the alpha channel based on a key color. This works for images created via the GDI, but can be an issue if you are drawing on top of a loaded picture.

3) inc/dec the alpha before/after drawing. This is a little trick I came up with .

The GDI draws using alpha 0. We want it alpha 255. So, if we increase the apha by 1 before drawing, and then draw, then decrease the alpha by 1, the original alpha will remain unchanged, but everything which was drawn at alpha 0, will now be 255. ie: Opaque. Anything that was already 255 will also remain at 255.

The problem then is, how to make this easy to use:
Code: Pascal  [Select][+][-]
  1. type
  2.  
  3.   TPictureEx = class(TPicture)
  4.   strict private
  5.     FAlpha: byte;
  6.   public
  7.     procedure UseAlpha(AAlpha: integer);
  8.     procedure EndAlpha;
  9.   end;
  10.  
  11. procedure TPictureEx.UseAlpha(AAlpha: integer);
  12. var
  13.   LPos, LEnd: PByte;
  14. begin
  15.   Assert(Bitmap.PixelFormat = pf32bit);
  16.   FAlpha := 256 - AAlpha;
  17.   Bitmap.BeginUpdate;
  18.   LPos := Bitmap.RawImage.Data + 3;
  19.   LEnd := Bitmap.RawImage.Data + Bitmap.RawImage.DataSize;
  20.   while LPos < LEnd do begin
  21.     Inc(LPos^, FAlpha);
  22.     Inc(LPos, 4);
  23.   end;
  24. end;
  25.  
  26. procedure TPictureEx.EndAlpha;
  27. var
  28.   LPos, LEnd: PByte;
  29. begin
  30.   Assert(Bitmap.PixelFormat = pf32bit);
  31.   LPos := Bitmap.RawImage.Data + 3;
  32.   LEnd := Bitmap.RawImage.Data + Bitmap.RawImage.DataSize;
  33.   while LPos < LEnd do begin
  34.     Dec(LPos^, FAlpha);
  35.     Inc(LPos, 4);
  36.   end;
  37.   Bitmap.EndUpdate;
  38. end;  
  39.  

Then you can do stuff like:

Code: Pascal  [Select][+][-]
  1.   with TPictureEx.Create do begin
  2.     try
  3.       Bitmap.PixelFormat := pf32bit;
  4.       Bitmap.SetSize(100, 100);
  5.       UseAlpha(0);
  6.       try
  7.         Bitmap.Canvas.Brush.Color := clBlack;
  8.         Bitmap.Canvas.FillRect(0, 0, Width, Height);
  9.       finally
  10.         EndAlpha;
  11.       end;
  12.       UseAlpha(255);
  13.       try
  14.         Bitmap.Canvas.Brush.Color := clRed;
  15.         Bitmap.Canvas.Ellipse(0, 0, Width, Height);
  16.       finally
  17.         EndAlpha;
  18.       end;
  19.       UseAlpha(128);
  20.       try
  21.         Bitmap.Canvas.Brush.Color := clBlue;
  22.         Bitmap.Canvas.FillRect(20, 20, Width - 20, Height - 20);
  23.       finally
  24.         EndAlpha;
  25.       end;
  26.       UseAlpha(255);
  27.       try
  28.         Bitmap.Canvas.Brush.Style := bsClear;
  29.         Bitmap.Canvas.Font.Color := clWhite;
  30.         Bitmap.Canvas.Font.Height := 40;
  31.         Bitmap.Canvas.TextOut(0, 0, 'Aplha');
  32.         Bitmap.Canvas.Font.Height := 35;
  33.         Bitmap.Canvas.TextOut(0, 45, 'Picture');
  34.       finally
  35.         EndAlpha;
  36.       end;
  37.       SaveToFile('c:\test.png');
  38.     finally
  39.       Free;
  40.     end;
  41.   end;  
  42.  

Note,

1) This method allows you to draw via the GDI at any alpha.
2) This method does _not_ support blending.
3) Text will look chunky because the font smoothing is not valid.

Anyway, that might help. Its only a quick and dirty way of drawing alpha graphics using the GDI.

Edit: A little talked about unit is imagemagick which comes with FreePascal.
http://www.imagemagick.org/script/index.php

It might suit your purposes if you dont like BGRABitmap.
« Last Edit: January 14, 2017, 09:04:42 pm by Geepster »

wp

  • Hero Member
  • *****
  • Posts: 11854
Re: Yet again transparent PNG
« Reply #5 on: January 14, 2017, 11:12:34 pm »
Here's another example which does not need any external libraries. It is based on LazIntfImage and FreeType (see also: http://forum.lazarus.freepascal.org/index.php/topic,26426.msg162327.html#msg162327). And if you use the forum search for FreeType LazIntfImage you'll certainly find more:

Code: Pascal  [Select][+][-]
  1. uses
  2.   GraphType, FpImage, intfGraphics, EasyLazFreeType, LazFreeTypeIntfDrawer;
  3.  
  4. procedure TForm1.Button1Click(Sender: TObject);
  5. var
  6.   png: TPortableNetworkGraphic;
  7.   img: TLazIntfImage;
  8.   drw: TIntfFreeTypeDrawer;
  9.   fnt: TFreeTypeFont;
  10. begin
  11.   png := TPortableNetworkGraphic.Create;
  12.   try
  13.     img := TLazIntfImage.Create(0,0, [riqfRGB, riqfAlpha]);
  14.     try
  15.       img.SetSize(400, 200);
  16.       drw := TIntfFreeTypeDrawer.Create(img);
  17.       fnt := TFreeTypeFont.Create;
  18.       try
  19.         fnt.Name := 'c:\Windows\fonts\Arial.ttf';
  20.         fnt.SizeInPixels := 36;
  21.         fnt.Hinted := true;
  22.         fnt.ClearType := true;
  23.         fnt.Quality := grqHighQuality;
  24.  
  25.         // Transparent background
  26.         drw.FillPixels(colTransparent);
  27.         // Yellow rectangle on transparent background
  28.         drw.FillRect(30, 30, img.Width-30, img.Height-30, colYellow);
  29.         // Text, partially on transparent background, partially on yellow rectangle
  30.         drw.DrawText('Lazarus', fnt, 0, 100, colRed);
  31.  
  32.         png.LoadFromIntfImage(img);
  33.         png.saveToFile('d:\test.png');
  34.       finally
  35.         fnt.Free;
  36.         drw.Free;
  37.       end;
  38.     finally
  39.       img.Free;
  40.     end;
  41.   finally
  42.     png.Free;
  43.   end;
  44. end;
« Last Edit: January 15, 2017, 12:55:57 am by wp »

lainz

  • Hero Member
  • *****
  • Posts: 4460
    • https://lainz.github.io/
Re: Yet again transparent PNG
« Reply #6 on: January 15, 2017, 12:12:27 am »
Of course you can try bgrabitmap if you want, at least give it a try, then decide if you want to use it or not:

These are all the uses you need,
Code: Pascal  [Select][+][-]
  1. uses
  2.   BGRABitmap, BGRABitmapTypes;

Or only use BGRABitmap unit alone if you don't need to change the font quality and use BGRAPixel (for example text with alpha on it). You can use TColor only if you want it, or if you need the background only to be transparent and not the text itself.

Code: Pascal  [Select][+][-]
  1. var
  2.   bmp: TBGRABitmap;
  3. begin
  4.   bmp := TBGRABitmap.Create(640, 480);
  5.   bmp.FontQuality := fqFineAntialiasing; // optional
  6.   bmp.FontHeight := 30;
  7.   bmp.TextOut(10, 10, 'Hello World', clBlack); // BGRABlack or BGRA(r, g, b, a) to specify easily rgba values
  8.   bmp.SaveToFile('text.png');
  9.   bmp.Free;
« Last Edit: January 15, 2017, 12:14:32 am by lainz »

Zaher

  • Hero Member
  • *****
  • Posts: 679
    • parmaja.org
Re: Yet again transparent PNG
« Reply #7 on: December 24, 2019, 09:18:34 pm »
Here's another example which does not need any external libraries. It is based on LazIntfImage and FreeType (see also: http://forum.lazarus.freepascal.org/index.php/topic,26426.msg162327.html#msg162327). And if you use the forum search for FreeType LazIntfImage you'll certainly find more:

Code: Pascal  [Select][+][-]
  1. uses
  2.   GraphType, FpImage, intfGraphics, EasyLazFreeType, LazFreeTypeIntfDrawer;
  3.  
  4. procedure TForm1.Button1Click(Sender: TObject);
  5. var
  6.   png: TPortableNetworkGraphic;
  7.   img: TLazIntfImage;
  8.   drw: TIntfFreeTypeDrawer;
  9.   fnt: TFreeTypeFont;
  10. begin
  11.   png := TPortableNetworkGraphic.Create;
  12.   try
  13.     img := TLazIntfImage.Create(0,0, [riqfRGB, riqfAlpha]);
  14.     try
  15.       img.SetSize(400, 200);
  16.       drw := TIntfFreeTypeDrawer.Create(img);
  17.       fnt := TFreeTypeFont.Create;
  18.       try
  19.         fnt.Name := 'c:\Windows\fonts\Arial.ttf';
  20.         fnt.SizeInPixels := 36;
  21.         fnt.Hinted := true;
  22.         fnt.ClearType := true;
  23.         fnt.Quality := grqHighQuality;
  24.  
  25.         // Transparent background
  26.         drw.FillPixels(colTransparent);
  27.         // Yellow rectangle on transparent background
  28.         drw.FillRect(30, 30, img.Width-30, img.Height-30, colYellow);
  29.         // Text, partially on transparent background, partially on yellow rectangle
  30.         drw.DrawText('Lazarus', fnt, 0, 100, colRed);
  31.  
  32.         png.LoadFromIntfImage(img);
  33.         png.saveToFile('d:\test.png');
  34.       finally
  35.         fnt.Free;
  36.         drw.Free;
  37.       end;
  38.     finally
  39.       img.Free;
  40.     end;
  41.   finally
  42.     png.Free;
  43.   end;
  44. end;

Thank you, that solved my problem.

 

TinyPortal © 2005-2018