* * *

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

Zaher

  • Hero Member
  • *****
  • Posts: 524
    • parmaja.com
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: [Select]
procedure PaintAliased(Canvas: TCanvas; x,y: integer; const TheText: string);
var
  w,h: integer;
  IntfImg: TLazIntfImage;
  Img: TPortableNetworkGraphic;
  dy: Integer;
  dx: Integer;
  col: TFPColor;
  FontColor: TColor;
  c: TColor;
begin
  w:=0;
  h:=0;
  Canvas.GetTextSize(TheText,w,h);
  if (w<=0) or (h<=0) then exit;
  Img:=TPortableNetworkGraphic.Create;
  IntfImg:=nil;
  try
    // paint text to a bitmap
    Img.Masked:=true;
    Img.SetSize(w,h);
    Img.Canvas.Brush.Style:=bsSolid;
    Img.Canvas.Brush.Color:=clWhite;
    Img.Canvas.FillRect(0,0,w,h);
    Img.Canvas.Font:=Canvas.Font;
    Img.Canvas.TextOut(0,0,TheText);
    // get memory image
    IntfImg:=Img.CreateIntfImage;
    // replace gray pixels
    FontColor:=ColorToRGB(Canvas.Font.Color);
    for dy:=0 to h-1 do begin
      for dx:=0 to w-1 do begin
        col:=IntfImg.Colors[dx,dy];
        c:=FPColorToTColor(col);
        if c<>FontColor then
          IntfImg.Colors[dx,dy]:=colTransparent;
      end;
    end;
    // create bitmap
    Img.LoadFromIntfImage(IntfImg);
    Img.Transparent := True;
    Img.TransparentColor := clBlack;
    Img.SaveToFile('d:\temp\myfont4.png');
    // paint
    Canvas.Draw(x,y,Img);
  finally
    IntfImg.Free;
    Img.Free;
  end;
end;

Any idea why i cant save as transparent file?

lainz

  • Hero Member
  • *****
  • Posts: 1797
  • Nace una flor, todos los días sale el sol...
    • BGRABitmap
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: 524
    • parmaja.com
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: 1797
  • Nace una flor, todos los días sale el sol...
    • BGRABitmap
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: 3336
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 »
Lazarus trunk / fpc 3.0.0 / Win32

lainz

  • Hero Member
  • *****
  • Posts: 1797
  • Nace una flor, todos los días sale el sol...
    • BGRABitmap
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 »

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus