unit uColorEmoji;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, freetypehdyn;
type
{ TEmoji }
TEmoji=class
protected
FLibrary: PFT_Library;
FError: FT_Error;
FFace: PFT_Face;
procedure DrawFreeTypeBitmap(ACanvas: TCanvas ;AFTBitmap: FT_Bitmap; X, Y: integer);
public
constructor Create(AFontFileName: String);
destructor Destroy; override;
procedure DrawUnicodeCodePoint(ACanvas: TCanvas; ACodePoint: FT_ULong; ALineHeight: integer; AX: integer);
end;
//Test
//DrawUnicodeCodePoint(Label1.Canvas, $1F61C, 160);
implementation
{ TEmoji }
constructor TEmoji.Create(AFontFileName: String);
begin
inherited Create;
InitializeFreetype('freetype.dll');
FError := FT_Init_FreeType(FLibrary);
{if LError <> 0 then
Exit;//}
FT_New_Face(FLibrary, PChar(AFontFileName), 0, FFace);
end;
destructor TEmoji.Destroy;
begin
//FT_Done_Face(Face);
ReleaseFreetype;
inherited Destroy;
end;
procedure TEmoji.DrawFreeTypeBitmap(ACanvas: TCanvas ;AFTBitmap: FT_Bitmap; X, Y: integer);
type
RGBQUAD = packed record
rgbRed, rgbGreen, rgbBlue, rgbReserved: byte
end;
TRGBQArray = array [0..High(integer) div 4 - 1] of RGBQUAD;
PRGBQArray = ^TRGBQArray;
var
LIsColor: boolean;
LIncValue: integer;
LBitmap: TBitmap;
LBytePos: integer;
LPosX: integer;
LPosY: integer;
LScanArray: PRGBQArray;
LColorQuad: RGBQUAD;
LByte: byte;
LBValue: byte;
LGValue: byte;
LRValue: byte;
LAValue: byte;
begin
LBitmap := TBitmap.Create;
try
LBitmap.SetSize(AFTBitmap.Width, AFTBitmap.rows);
LBitmap.PixelFormat := pf32bit;
//LBitmap.AlphaFormat := afDefined;
LIncValue := 1;
LIsColor := AFTBitmap.Width = AFTBitmap.pitch div 4;
if LIsColor then
LIncValue := 4;
LBytePos := 0;
for LPosY := 0 to LBitmap.Height - 1 do
begin
LScanArray := LBitmap.ScanLine[LPosY];
for LPosX := 0 to LBitmap.Width - 1 do
begin
if LIsColor then
begin
LRValue := PByte(AFTBitmap.buffer)[LBytePos + 0];
LGValue := PByte(AFTBitmap.buffer)[LBytePos + 1];
LBValue := PByte(AFTBitmap.buffer)[LBytePos + 2];
LAValue := PByte(AFTBitmap.buffer)[LBytePos + 3];
end
else
begin
LByte := pByte(AFTBitmap.buffer)[LBytePos];
if LByte <> $00 then
begin
LRValue := $00;
LGValue := $00;
LBValue := $00;
LAValue := $FF;
end
else
begin
LRValue := $FF;
LGValue := $FF;
LBValue := $FF;
LAValue := $FF;
end;
end;
LColorQuad.rgbRed := LRValue;
LColorQuad.rgbGreen := LGValue;
LColorQuad.rgbBlue := LBValue;
LColorQuad.rgbReserved := LAValue;
LScanArray^[LPosX] := LColorQuad;
Inc(LBytePos, LIncValue);
end;
end;
ACanvas.Draw(X, y, LBitmap);
finally
FreeAndNil(LBitmap);
end;
end;
procedure TEmoji.DrawUnicodeCodePoint(ACanvas: TCanvas; ACodePoint: FT_ULong;
ALineHeight: integer; AX: integer);
const
FT_LOAD_COLOR = 1 shl 20;//<--missing from freetypehdyn
var
LGlyphIndex: FT_UInt;
LGlyphSlot: PFT_GlyphSlot;
LDrawLeft: integer;
LDrawTop: integer;
begin
{ ACanvas.Brush.Style := bsClear;
ACanvas.Brush.Color := clSilver;
//ACanvas.FillRect(ACanvas.ClipRect);
//}
FT_Set_Pixel_Sizes(FFace, 0, ALineHeight);
LGlyphIndex := FT_Get_Char_Index(FFace, ACodePoint);
if LGlyphIndex=0 then
exit;
FError := FT_Load_Glyph(FFace, LGlyphIndex, FT_LOAD_COLOR {or FT_LOAD_RENDER});
LGlyphSlot := FFace^.glyph;
FError := FT_Render_Glyph(LGlyphSlot, FT_RENDER_MODE_NORMAL);
LDrawLeft := AX;
LDrawTop := ALineHeight - FFace^.glyph^.bitmap_top;
ACanvas.FillRect(AX,0, AX+10+FFace^.glyph^.bitmap.width,ACanvas.Height);
DrawFreeTypeBitmap(ACanvas, LGlyphSlot^.bitmap, LDrawLeft, LDrawTop);
end;
end.