Recent

Author Topic: How to display coloured emojis on Windows?  (Read 5659 times)

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: How to display coloured emojis on Windows?
« Reply #15 on: September 27, 2021, 11:54:29 pm »
Here is the code that I had found long ago on a Japanese website. I made a class of the original code:
Code: Pascal  [Select][+][-]
  1. unit uColorEmoji;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Graphics, freetypehdyn;
  9.  
  10. type
  11.  
  12.   { TEmoji }
  13.  
  14.   TEmoji=class
  15.   protected
  16.     FLibrary: PFT_Library;
  17.     FError: FT_Error;
  18.     FFace: PFT_Face;
  19.     procedure DrawFreeTypeBitmap(ACanvas: TCanvas ;AFTBitmap: FT_Bitmap; X, Y: integer);
  20.   public
  21.     constructor Create(AFontFileName: String);
  22.     destructor Destroy; override;
  23.     procedure DrawUnicodeCodePoint(ACanvas: TCanvas; ACodePoint: FT_ULong; ALineHeight: integer; AX: integer);
  24.   end;
  25.  
  26. //Test
  27. //DrawUnicodeCodePoint(Label1.Canvas, $1F61C, 160);
  28.  
  29. implementation
  30.  
  31. { TEmoji }
  32.  
  33. constructor TEmoji.Create(AFontFileName: String);
  34. begin
  35.   inherited Create;
  36.  
  37.   InitializeFreetype('freetype.dll');
  38.   FError := FT_Init_FreeType(FLibrary);
  39.   {if LError <> 0 then
  40.     Exit;//}
  41.   FT_New_Face(FLibrary, PChar(AFontFileName), 0, FFace);
  42. end;
  43.  
  44. destructor TEmoji.Destroy;
  45. begin
  46.   //FT_Done_Face(Face);
  47.   ReleaseFreetype;
  48.   inherited Destroy;
  49. end;
  50.  
  51. procedure TEmoji.DrawFreeTypeBitmap(ACanvas: TCanvas ;AFTBitmap: FT_Bitmap; X, Y: integer);
  52. type
  53.   RGBQUAD = packed record
  54.     rgbRed, rgbGreen, rgbBlue, rgbReserved: byte
  55.   end;
  56.   TRGBQArray = array [0..High(integer) div 4 - 1] of RGBQUAD;
  57.   PRGBQArray = ^TRGBQArray;
  58. var
  59.   LIsColor: boolean;
  60.   LIncValue: integer;
  61.   LBitmap: TBitmap;
  62.   LBytePos: integer;
  63.   LPosX: integer;
  64.   LPosY: integer;
  65.   LScanArray: PRGBQArray;
  66.   LColorQuad: RGBQUAD;
  67.   LByte: byte;
  68.   LBValue: byte;
  69.   LGValue: byte;
  70.   LRValue: byte;
  71.   LAValue: byte;
  72. begin
  73.   LBitmap := TBitmap.Create;
  74.   try
  75.     LBitmap.SetSize(AFTBitmap.Width, AFTBitmap.rows);
  76.     LBitmap.PixelFormat := pf32bit;
  77.     //LBitmap.AlphaFormat := afDefined;
  78.  
  79.     LIncValue := 1;
  80.     LIsColor := AFTBitmap.Width = AFTBitmap.pitch div 4;
  81.     if LIsColor then
  82.       LIncValue := 4;
  83.  
  84.     LBytePos := 0;
  85.     for LPosY := 0 to LBitmap.Height - 1 do
  86.     begin
  87.       LScanArray := LBitmap.ScanLine[LPosY];
  88.  
  89.       for LPosX := 0 to LBitmap.Width - 1 do
  90.       begin
  91.         if LIsColor then
  92.         begin
  93.           LRValue := PByte(AFTBitmap.buffer)[LBytePos + 0];
  94.           LGValue := PByte(AFTBitmap.buffer)[LBytePos + 1];
  95.           LBValue := PByte(AFTBitmap.buffer)[LBytePos + 2];
  96.           LAValue := PByte(AFTBitmap.buffer)[LBytePos + 3];
  97.         end
  98.         else
  99.         begin
  100.           LByte := pByte(AFTBitmap.buffer)[LBytePos];
  101.           if LByte <> $00 then
  102.           begin
  103.             LRValue := $00;
  104.             LGValue := $00;
  105.             LBValue := $00;
  106.             LAValue := $FF;
  107.           end
  108.           else
  109.           begin
  110.             LRValue := $FF;
  111.             LGValue := $FF;
  112.             LBValue := $FF;
  113.             LAValue := $FF;
  114.           end;
  115.         end;
  116.  
  117.         LColorQuad.rgbRed := LRValue;
  118.         LColorQuad.rgbGreen := LGValue;
  119.         LColorQuad.rgbBlue := LBValue;
  120.         LColorQuad.rgbReserved := LAValue;
  121.  
  122.         LScanArray^[LPosX] := LColorQuad;
  123.  
  124.         Inc(LBytePos, LIncValue);
  125.       end;
  126.     end;
  127.  
  128.     ACanvas.Draw(X, y, LBitmap);
  129.   finally
  130.     FreeAndNil(LBitmap);
  131.   end;
  132. end;
  133.  
  134. procedure TEmoji.DrawUnicodeCodePoint(ACanvas: TCanvas; ACodePoint: FT_ULong;
  135.   ALineHeight: integer; AX: integer);
  136.  
  137. const
  138.   FT_LOAD_COLOR = 1 shl 20;//<--missing from freetypehdyn
  139.  
  140. var
  141.   LGlyphIndex: FT_UInt;
  142.   LGlyphSlot: PFT_GlyphSlot;
  143.   LDrawLeft: integer;
  144.   LDrawTop: integer;
  145. begin
  146. {  ACanvas.Brush.Style := bsClear;
  147.   ACanvas.Brush.Color := clSilver;
  148.   //ACanvas.FillRect(ACanvas.ClipRect);
  149.  
  150.  //}
  151.   FT_Set_Pixel_Sizes(FFace, 0, ALineHeight);
  152.  
  153.   LGlyphIndex := FT_Get_Char_Index(FFace, ACodePoint);
  154.   if LGlyphIndex=0 then
  155.     exit;
  156.  
  157.   FError := FT_Load_Glyph(FFace, LGlyphIndex, FT_LOAD_COLOR {or FT_LOAD_RENDER});
  158.  
  159.   LGlyphSlot := FFace^.glyph;
  160.   FError := FT_Render_Glyph(LGlyphSlot, FT_RENDER_MODE_NORMAL);
  161.  
  162.   LDrawLeft := AX;
  163.   LDrawTop := ALineHeight - FFace^.glyph^.bitmap_top;
  164.  
  165.   ACanvas.FillRect(AX,0, AX+10+FFace^.glyph^.bitmap.width,ACanvas.Height);
  166.  
  167.   DrawFreeTypeBitmap(ACanvas, LGlyphSlot^.bitmap, LDrawLeft, LDrawTop);
  168. end;
  169.  
  170. end.

Test it with a button and a label, like:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   Emoji: TEmoji;
  4.   fileName: String;
  5. begin
  6.   fileName := 'c:\Windows\Fonts\seguiemj.ttf';
  7.   //fileName := 'c:\Windows\Fonts\OpenSansEmoji.otf';
  8.   //fileName := 'c:\Windows\Fonts\unifont-13.0.06.ttf';
  9.   //fileName := 'c:\Windows\Fonts\TwitterColorEmoji-SVGinOT.ttf';//<--- complete list
  10.   Emoji := TEmoji.Create(fileName);
  11.   try
  12.     Emoji.DrawUnicodeCodePoint(Label1.Canvas, $1F61C, 160, 10);
  13.   finally
  14.     Emoji.Free;
  15.   end;
  16. end;

I think I needed it on a system that does not support colored emojis.

1st Edit:
You still need a FreeType library, if you don't already have it on your system.

2nd Edit:
I just realized freetypehdyn is missing one needed function: FT_Render_Glyph.
I modified freetypehdyn to include it.
« Last Edit: September 28, 2021, 12:06:37 am by engkin »

wp

  • Hero Member
  • *****
  • Posts: 11853
Re: How to display coloured emojis on Windows?
« Reply #16 on: September 28, 2021, 12:12:03 am »
That's interesting code, thanks for sharing. However, the compiler (3.2.2, 3.2.0) chokes on FT_Render_Glyph.

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: How to display coloured emojis on Windows?
« Reply #17 on: September 28, 2021, 02:33:49 am »
Sorry, I meant to provide that function as well. Add the attached files to your project.

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: How to display coloured emojis on Windows?
« Reply #18 on: September 28, 2021, 01:42:41 pm »
hello,
strange, it seems that with use of freetypefont (engkin's unit) , the emojis are not the same that the segoe ui emojis ( see attachment 1). And i have some trouble with transparency.
I have a new method to display emojis  in lazarus :
1 - get the internet page where you have seen the emojis which you want (ex : https://unicode.org/emoji/charts/emoji-list.html ) with fpthttpclient
2 - parse the html to extract all the lines of the table with emojis (with sax_html)
3 - on each line get the caption of the emoji and the base64 string of the emoji's image. Convert the base64 string to bitmap. put the bitmap in an imagelist. Put the caption in a listview (with imagelist as largeimages).
See the result in attachment 2.

Friendly, J.P
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: How to display coloured emojis on Windows?
« Reply #19 on: September 28, 2021, 01:56:07 pm »
strange, it seems that with use of freetypefont (engkin's unit) , the emojis are not the same that the segoe ui emojis ( see attachment 1).

That's because there are different styles of Emojis. The Segoe UI emojis are those designed by Microsoft while the ones you loaded from the internet look like the Apple ones. There are many more of course...

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: How to display coloured emojis on Windows?
« Reply #20 on: September 28, 2021, 02:32:56 pm »
That's because there are different styles of Emojis. The Segoe UI emojis are those designed by Microsoft while the ones you loaded from the internet look like the Apple ones. There are many more of course.
but the freetypefont is "linked" to segoe ui emojis font :
Code: Pascal  [Select][+][-]
  1.  fileName := extractfiledir(paramstr(0))+ '\seguiemj.ttf';
  2.    Emoji := TEmoji.Create(fileName);
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: How to display coloured emojis on Windows?
« Reply #21 on: September 28, 2021, 04:08:11 pm »
strange, it seems that with use of freetypefont (engkin's unit) , the emojis are not the same that the segoe ui emojis ( see attachment 1).

I vaguely remember discovering the browser "cheating" when it comes to displaying emojis.

Also,, I think I had another function included in the attached file above to help find an emoji based on its name.

wp

  • Hero Member
  • *****
  • Posts: 11853
Re: How to display coloured emojis on Windows?
« Reply #22 on: September 28, 2021, 04:10:08 pm »
Add the attached files to your project.
Engkin, thanks for this nice code. Are you planning to file a feature request to the fpc project so that the missing procedures are added to the "official" libfreetype?

BTW, there is also a LazFreeType library (in components/freetype of the Laz installation). I guess your code can be adapted to work with this lib as well?

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: How to display coloured emojis on Windows?
« Reply #23 on: September 28, 2021, 04:31:20 pm »
wp,
have you try the uColorEmoji unit ?
i have some trouble with transparency : may be my code is wrong :
here is the code :
Code: Pascal  [Select][+][-]
  1. // uses uColorEmoji;
  2. var
  3.     bmp: TBitmap;
  4.     LI: TListItem;
  5.     Emoji: TEmoji;
  6.     fileName: String;
  7.    index: Integer;
  8. begin
  9.    bmp := TBitmap.Create;
  10.    bmp.SetSize(32,32);
  11.    fileName := extractfiledir(paramstr(0))+ '\seguiemj.ttf';
  12.    Emoji := TEmoji.Create(fileName);
  13.    try
  14.       For index:=0 to 79 do
  15.        begin
  16.           Emoji.DrawUnicodeCodePoint(bmp.Canvas, $1F600 + index, 32, 0); //[EDIT] oops index forgotten
  17.           LI := ListView1.Items.Add;
  18.           LI.Caption    := 'Emoji' + IntToStr(index);
  19.           LI.ImageIndex := index;
  20.           ImageList1.Add(bmp,nil);
  21.         end;
  22.    finally
  23.     bmp.Free;
  24.     Emoji.Free;
  25.   end;      

and for the use of EasyLazFreeType

Code: Pascal  [Select][+][-]
  1. // uses fpimage,IntfGraphics, GraphType,  EasyLazFreeType,  LazFreeTypeIntfDrawer;
  2. var
  3.   charIndex: integer;
  4.   lazimg: TLazIntfImage;
  5.   FTTFFont: TFreeTypeFont;
  6.   drawer: TIntfFreeTypeDrawer;    
  7. begin
  8.   lazimg := TLazIntfImage.Create(0,0, [riqfRGB]);
  9.   lazimg.SetSize(Image1.Width,Image1.Height);
  10.   FTTFFont:=TFreeTypeFont.create;
  11.   FTTFFont.Hinted:=false;
  12.   FTTFFont.Name:= extractfiledir(paramstr(0))+'\seguiemj.ttf';
  13.   ShowMessage(inttoStr(FTTFFont.GlyphCount));
  14.   FTTFFont.SizeInPoints := 24;
  15.   drawer := TIntfFreeTypeDrawer.Create(lazimg);
  16.   drawer.FillPixels(TColorToFPColor(clYellow));
  17.   charIndex :=  FTTFFont.CharIndex[$1F600]; // not working
  18.   drawer.DrawGlyph(2093,FTTFFont,0,30,TColorToFPColor(clBlack)); // force to index 2093
  19.   Image1.Picture.Bitmap.LoadFromIntfImage(lazimg);
  20.   drawer.free;
  21.   FTTFFont.Free;
  22.  
CharIndex return 0 and of course the emoji is black ( DrawGlyph).

Friendly, J.P
« Last Edit: September 28, 2021, 05:14:39 pm by Jurassic Pork »
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

wp

  • Hero Member
  • *****
  • Posts: 11853
Re: How to display coloured emojis on Windows?
« Reply #24 on: September 28, 2021, 05:27:26 pm »
Sorry I don't know what to do with these code snippets. Could you upload them in a compilable project?

Yes I tried Engkin's uColorEmoji unit, and it works correctly regarding transparency - see attchment

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: How to display coloured emojis on Windows?
« Reply #25 on: September 28, 2021, 05:39:26 pm »
ok thanks wp i have found the error in my code --> i have put wrong args in the DrawUnicodeCodePoint procedure and wrong ttf . it is for that i have the wrong emojis.
With your project it is OK !
in Attachment my project with a better code.
« Last Edit: September 28, 2021, 06:28:16 pm by Jurassic Pork »
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

Jurassic Pork

  • Hero Member
  • *****
  • Posts: 1228
Re: How to display coloured emojis on Windows?
« Reply #26 on: September 29, 2021, 12:48:51 pm »
hello,
and for the use of EasyLazFreeType :
Code: Pascal  [Select][+][-]
  1. // uses fpimage,IntfGraphics, GraphType,  EasyLazFreeType,  LazFreeTypeIntfDrawer;
  2. var
  3.   charIndex: integer;
  4.   lazimg: TLazIntfImage;
  5.   FTTFFont: TFreeTypeFont;
  6.   drawer: TIntfFreeTypeDrawer;    
  7. begin
  8.   lazimg := TLazIntfImage.Create(0,0, [riqfRGB]);
  9.   lazimg.SetSize(Image1.Width,Image1.Height);
  10.   FTTFFont:=TFreeTypeFont.create;
  11.   FTTFFont.Hinted:=false;
  12.   FTTFFont.Name:= extractfiledir(paramstr(0))+'\seguiemj.ttf';
  13.   ShowMessage(inttoStr(FTTFFont.GlyphCount));
  14.   FTTFFont.SizeInPoints := 24;
  15.   drawer := TIntfFreeTypeDrawer.Create(lazimg);
  16.   drawer.FillPixels(TColorToFPColor(clYellow));
  17.   charIndex :=  FTTFFont.CharIndex[$1F600]; // not working
  18.   drawer.DrawGlyph(11680,FTTFFont,0,30,TColorToFPColor(clBlack)); // force to index 11680
  19.   Image1.Picture.Bitmap.LoadFromIntfImage(lazimg);
  20.   drawer.free;
  21.   FTTFFont.Free;
  22.  
CharIndex return 0 and of course the emoji is black ( DrawGlyph).

Friendly, J.P
CharIndex returns 0 because LazFreeType isn't up to date. The file ttcmap.pas contains only 4 formats of cmap (0,2,4,6). In the latest file ttcmap.c of freetype project we have   9 formats (0,2,4,6,8,10,12,13,14).
The font segoe ui emojis uses the formats  4,12,14.

Friendly, J.P
« Last Edit: September 29, 2021, 12:58:03 pm by Jurassic Pork »
Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: How to display coloured emojis on Windows?
« Reply #27 on: September 29, 2021, 01:17:50 pm »
That's because there are different styles of Emojis. The Segoe UI emojis are those designed by Microsoft while the ones you loaded from the internet look like the Apple ones. There are many more of course.
but the freetypefont is "linked" to segoe ui emojis font :
Code: Pascal  [Select][+][-]
  1.  fileName := extractfiledir(paramstr(0))+ '\seguiemj.ttf';
  2.    Emoji := TEmoji.Create(fileName);

And Segoe UI contains the Microsoft Emojis so I don't know why you're confused here?

engkin

  • Hero Member
  • *****
  • Posts: 3112
Re: How to display coloured emojis on Windows?
« Reply #28 on: October 03, 2021, 08:30:43 am »
Are you planning to file a feature request to the fpc project so that the missing procedures are added to the "official" libfreetype?

Yes, sure. As soon as I get a chance unless you beat me to it.

It needs the static version of these functions to be added as well, a missing constant, and testing it on Windows as least.

 

TinyPortal © 2005-2018