* Support unicode text drawing in freetype, canvas

git-svn-id: trunk@36402 -

.gitattributes

@@ -2440,6 +2440,7 @@ packages/fcl-image/examples/drawing.pp svneol=native#text/plain
 packages/fcl-image/examples/imgconv.pp svneol=native#text/plain
 packages/fcl-image/examples/interpoldemo.pp svneol=native#text/plain
 packages/fcl-image/examples/pattern.png -text svneol=unset#image/png
+packages/fcl-image/examples/textout.pp svneol=native#text/plain
 packages/fcl-image/examples/xwdtobmp.pas svneol=native#text/plain
 packages/fcl-image/fpmake.pp svneol=native#text/plain
 packages/fcl-image/src/bmpcomn.pp svneol=native#text/plain

packages/fcl-image/examples/textout.pp

@@ -0,0 +1,116 @@
+{$mode objfpc}{$h+}
+{$CODEPAGE UTF8}
+program textout;
+
+uses
+  cwstring,classes, sysutils, FPImage, FPCanvas, FPImgCanv, ftFont, FPWritePNG, freetype;
+
+const
+  MyColor : TFPColor = (Red: $7FFF; Green: $0000; Blue: $FFFF; Alpha: alphaOpaque);
+
+procedure DoDraw(FN, fnChinese : String);
+
+var
+  canvas : TFPcustomCAnvas;
+  image : TFPCustomImage;
+  writer : TFPCustomImageWriter;
+  f : TFreeTypeFont;
+  S : String;
+  U : UnicodeString;
+
+begin
+  f:=Nil;
+  image := TFPMemoryImage.Create (256,256);
+  Canvas := TFPImageCanvas.Create (image);
+  Writer := TFPWriterPNG.Create;
+  InitEngine;
+  with TFPWriterPNG(Writer) do
+    begin
+    indexed := false;
+    wordsized := false;
+    UseAlpha := false;
+    GrayScale := false;
+    end;
+  try
+    with Canvas as TFPImageCanvas do
+      begin
+      // Clear background
+      brush.FPcolor:=colwhite;
+      brush.style:=bsSolid;
+      pen.mode := pmCopy;
+      pen.style := psSolid;
+      pen.width := 1;
+      pen.FPColor := colWhite;
+      FillRect(0,0,255,255);
+      // Set font
+      F:=TFreeTypeFont.Create;
+      Font:=F;
+      Font.Name:=FN;
+      Font.Size:=14;
+      Font.FPColor:=colBlack;
+      S:='Hello, world!';
+      Canvas.TextOut(20,20,S);
+      U:=UTF8Decode('привет, Мир!');
+      Font.FPColor:=colBlue;
+      Canvas.TextOut(50,50,U);
+      if (FNChinese<>'') then
+        begin
+        Font.Name:=FNChinese;
+        U:=UTF8Decode('你好，世界!');
+        Font.FPColor:=colRed;
+        Canvas.TextOut(20,100,U);
+        end
+      else
+        begin
+        Font.Size:=10;
+        Canvas.TextOut(20,100,'No chinese font available.');
+        end;
+      U:=UTF8Decode('non-ASCII chars: ßéùµàçè§âêû');
+      Font.Size:=10;
+      Canvas.TextOut(20,180,U);
+      end;
+    writeln ('Saving to "TextTest.png" for inspection !');
+    Image.SaveToFile ('TextTest.png', writer);
+  finally
+    F.Free;
+    Canvas.Free;
+    image.Free;
+    writer.Free;
+  end;
+end;
+
+Var
+  D,FontFile, FontFileChinese : String;
+  Info : TSearchRec;
+
+begin
+  // Initialize font search path;
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+  D := '/usr/share/fonts/truetype/';
+  DefaultSearchPath:=D;
+  if FindFirst(DefaultSearchPath+AllFilesMask,faDirectory,Info)=0 then
+    try
+      repeat
+        if (Info.Attr and faDirectory)<>0 then
+          if (Info.Name<>'.') and (info.name<>'..') then
+            DefaultSearchPath:=DefaultSearchPath+';'+D+Info.Name;
+      Until FindNext(Info)<>0;
+    finally
+      FindClose(Info);
+    end;
+{$ENDIF}
+{$ENDIF}
+  FontFile:=ParamStr(1);
+  if FontFile='' then
+    FontFile:='LiberationSans-Regular.ttf';
+  FontFileChinese:=ParamStr(2);
+  if FontFileChinese='' then
+    With TFontManager.Create do
+      try
+          FontFileChinese:=SearchFont('wqy-microhei.ttc',False);
+      finally
+        Free;
+      end;
+  DoDraw(FontFile,FontFileChinese);
+end.

packages/fcl-image/src/fpcanvas.inc

@@ -353,6 +353,77 @@ begin
     result := DoGetTextWidth (Text);
 end;
 
+procedure TFPCustomCanvas.TextOut (x,y:integer;text:unicodestring);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).DrawText(x,y, text)
+  else
+    DoTextOut (x,y, text);
+end;
+
+procedure TFPCustomCanvas.GetTextSize (text:unicodestring; var w,h:integer);
+begin
+  if Font is TFPCustomDrawFont then
+    TFPCustomDrawFont(Font).GetTextSize (text, w, h)
+  else
+    DoGetTextSize (Text, w, h);
+end;
+
+function TFPCustomCanvas.GetTextHeight (text:unicodestring) : integer;
+begin
+  Result := TextHeight(Text);
+end;
+
+function TFPCustomCanvas.GetTextWidth (text:unicodestring) : integer;
+begin
+  Result := TextWidth(Text);
+end;
+
+function TFPCustomCanvas.TextExtent(const Text: unicodestring): TSize;
+begin
+  GetTextSize(Text, Result.cx, Result.cy);
+end;
+
+function TFPCustomCanvas.TextHeight(const Text: unicodestring): Integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextHeight (text)
+  else
+    result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomCanvas.TextWidth(const Text: unicodestring): Integer;
+begin
+  if Font is TFPCustomDrawFont then
+    result := TFPCustomDrawFont(Font).GetTextWidth (text)
+  else
+    result := DoGetTextWidth (Text);
+end;
+
+procedure TFPCustomCanvas.DoTextOut (x,y:integer;text:unicodestring); 
+
+begin
+  DoTextOut(x,y,string(text));
+end;
+
+procedure TFPCustomCanvas.DoGetTextSize (text:unicodestring; var w,h:integer); 
+
+begin
+  DoGetTextSize(String(Text),w,h);
+end;
+
+function  TFPCustomCanvas.DoGetTextHeight (text:unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextHeight(String(text));
+end;
+
+function  TFPCustomCanvas.DoGetTextWidth (text:unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextWidth(String(text));
+end;
+
 procedure TFPCustomCanvas.Arc(ALeft, ATop, ARight, ABottom, Angle16Deg,
   Angle16DegLength: Integer);
 begin

packages/fcl-image/src/fpcanvas.pp

@@ -278,6 +278,10 @@ type
     procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
     function  DoGetTextHeight (text:string) : integer; virtual; abstract;
     function  DoGetTextWidth (text:string) : integer; virtual; abstract;
+    procedure DoTextOut (x,y:integer;text:unicodestring); virtual; 
+    procedure DoGetTextSize (text:unicodestring; var w,h:integer); virtual; 
+    function  DoGetTextHeight (text:unicodestring) : integer; virtual; 
+    function  DoGetTextWidth (text:unicodestring) : integer; virtual; 
     procedure DoRectangle (Const Bounds:TRect); virtual; abstract;
     procedure DoRectangleFill (Const Bounds:TRect); virtual; abstract;
     procedure DoRectangleAndFill (Const Bounds:TRect); virtual;
@@ -317,6 +321,13 @@ type
     function TextExtent(const Text: string): TSize; virtual;
     function TextHeight(const Text: string): Integer; virtual;
     function TextWidth(const Text: string): Integer; virtual;
+    procedure TextOut (x,y:integer;text:unicodestring); virtual;
+    procedure GetTextSize (text:unicodestring; var w,h:integer);
+    function GetTextHeight (text:unicodestring) : integer;
+    function GetTextWidth (text:unicodestring) : integer;
+    function TextExtent(const Text: unicodestring): TSize; virtual;
+    function TextHeight(const Text: unicodestring): Integer; virtual;
+    function TextWidth(const Text: unicodestring): Integer; virtual;
     // using pen and brush
     procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual;
     procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual;
@@ -374,11 +385,19 @@ type
     procedure GetTextSize (text:string; var w,h:integer);
     function GetTextHeight (text:string) : integer;
     function GetTextWidth (text:string) : integer;
+    procedure DrawText (x,y:integer; text:unicodestring);
+    procedure GetTextSize (text: unicodestring; var w,h:integer);
+    function GetTextHeight (text: unicodestring) : integer;
+    function GetTextWidth (text: unicodestring) : integer;
   protected
     procedure DoDrawText (x,y:integer; text:string); virtual; abstract;
     procedure DoGetTextSize (text:string; var w,h:integer); virtual; abstract;
     function DoGetTextHeight (text:string) : integer; virtual; abstract;
     function DoGetTextWidth (text:string) : integer; virtual; abstract;
+    procedure DoDrawText (x,y:integer; text:unicodestring); virtual;
+    procedure DoGetTextSize (text: unicodestring; var w,h:integer); virtual; 
+    function DoGetTextHeight (text: unicodestring) : integer; virtual; 
+    function DoGetTextWidth (text: unicodestring) : integer; virtual; 
   end;
 
   TFPEmptyFont = class (TFPCustomFont)

packages/fcl-image/src/fpcdrawh.inc

@@ -77,3 +77,50 @@ function TFPCustomDrawFont.GetTextWidth (text:string) : integer;
 begin
   result := DoGetTextWidth (Text);
 end;
+
+procedure TFPCustomDrawFont.DrawText (x,y:integer; text:UnicodeString);
+begin
+  DoDrawText (x,y, text);
+end;
+
+procedure TFPCustomDrawFont.GetTextSize (text:UnicodeString; var w,h:integer);
+begin
+  DoGetTextSize (text, w,h);
+end;
+
+function TFPCustomDrawFont.GetTextHeight (text:UnicodeString) : integer;
+begin
+  result := DoGetTextHeight (Text);
+end;
+
+function TFPCustomDrawFont.GetTextWidth (text:UnicodeString) : integer;
+begin
+  result := DoGetTextWidth (Text);
+end;
+
+procedure TFPCustomDrawFont.DoDrawText (x,y:integer; text:unicodestring); 
+
+begin
+  DoDrawText(x,y,String(text));
+end;
+
+procedure TFPCustomDrawFont.DoGetTextSize (text: unicodestring; var w,h:integer); 
+
+begin
+  DoGetTextSize(String(text),w,h);
+end;
+
+
+
+function TFPCustomDrawFont.DoGetTextHeight (text: unicodestring) : integer;  
+
+begin
+  Result:=DoGetTextHeight(String(text));
+end;
+
+function TFPCustomDrawFont.DoGetTextWidth (text: unicodestring) : integer; 
+
+begin
+  Result:=DoGetTextWidth(String(text));
+end;
+

packages/fcl-image/src/freetype.pp

@@ -48,11 +48,10 @@ type
   PFontBitmap = ^TFontBitmap;
 
 
-  TStringBitMaps = class
+  TBaseStringBitMaps = class
     private
       FList : TList;
       FBounds : TRect;
-      FText : string;
       FMode : TBitmapType;
       function GetCount : integer;
       function GetBitmap (index:integer) : PFontBitmap;
@@ -61,17 +60,30 @@ type
       constructor Create (ACount : integer);
       destructor destroy; override;
       procedure GetBoundRect (out aRect : TRect);
-      property Text : string read FText;
       property Mode : TBitmapType read FMode;
       property Count : integer read GetCount;
       property Bitmaps[index:integer] : PFontBitmap read GetBitmap;
   end;
 
+  TStringBitMaps = class(TBaseStringBitMaps)
+    private
+      FText : STring;
+    public
+      property Text : string read FText;
+  end;
+
+  TUnicodeStringBitMaps = class(TBaseStringBitMaps)
+  private
+    FText : UnicodeString;
+  public
+    property Text : Unicodestring read FText;
+  end;
+
   TFontManager = class;
 
   PMgrGlyph = ^TMgrGlyph;
   TMgrGlyph = record
-    Character : char;
+    Character : unicodechar;
     GlyphIndex : FT_UInt;
     Glyph : PFT_Glyph;
   end;
@@ -109,33 +121,41 @@ type
       function GetSearchPath : string;
       procedure SetSearchPath (AValue : string);
       procedure SetExtention (AValue : string);
+      Procedure DoMakeString (Text : Array of cardinal; ABitmaps  : TBaseStringBitmaps);
+      Procedure DoMakeString (Text : Array of cardinal; angle: real; ABitmaps  : TBaseStringBitmaps);
     protected
       function GetFontId (afilename:string; anindex:integer) : integer;
       function CreateFont (afilename:string; anindex:integer) : integer;
-      function SearchFont (afilename:string) : string;
       function GetFont (FontID:integer) : TMgrFont;
       procedure GetSize (aSize, aResolution : integer);
       function CreateSize (aSize, aResolution : integer) : PMgrSize;
       procedure SetPixelSize (aSize, aResolution : integer);
-      function GetGlyph (c : char) : PMgrGlyph;
-      function CreateGlyph (c : char) : PMgrGlyph;
+      function GetGlyph (c : cardinal) : PMgrGlyph;
+      function CreateGlyph (c : cardinal) : PMgrGlyph;
       procedure MakeTransformation (angle:real; out Transformation:FT_Matrix);
       procedure InitMakeString (FontID, Size:integer);
       function MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
       function MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
     public
       constructor Create;
       destructor destroy; override;
+      function SearchFont(afilename: string; doraise: boolean=true): string;
       function RequestFont (afilename:string) : integer;
       function RequestFont (afilename:string; anindex:integer) : integer;
       function GetFreeTypeFont (aFontID:integer) : PFT_Face;
       function GetString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
       // Black and white
       function GetStringGray (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
       // Anti Aliased gray scale
       function GetString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
       // Black and white, following the direction of the font (left to right, top to bottom, ...)
-      function GetStringGray (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text: String; Size:integer) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
       // Anti Aliased gray scale, following the direction of the font (left to right, top to bottom, ...)
       property SearchPath : string read GetSearchPath write SetSearchPath;
       property DefaultExtention : string read FExtention write SetExtention;
@@ -381,11 +401,12 @@ begin
     AValue := '';
 end;
 
-function TFontManager.SearchFont (afilename:string) : string;
+function TFontManager.SearchFont (afilename:string; doraise : boolean = true) : string;
 // returns full filename of font, taking SearchPath in account
 var p,fn : string;
     r : integer;
 begin
+  Result:='';
   if (pos('.', afilename)=0) and (DefaultFontExtention<>'') then
     fn := afilename + DefaultFontExtention
   else
@@ -401,14 +422,12 @@ begin
       repeat
         dec (r);
       until (r < 0) or FileExists(FPaths[r]+fn);
-      if r < 0 then
-        raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [fn])
-      else
-        result := FPaths[r]+fn;
+      if r >= 0 then
+        Result := FPaths[r]+fn;
       end
-    else
-      raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [afilename]);
     end;
+  if (Result='') and doRaise then
+    raise FreeTypeException.CreateFmt (sErrFontFileNotFound, [fn])
 end;
 
 function TFontManager.GetFontId (afilename:string; anindex:integer) : integer;
@@ -527,13 +546,13 @@ begin
     end;
 end;
 
-function TFontManager.CreateGlyph (c : char) : PMgrGlyph;
+function TFontManager.CreateGlyph (c : cardinal) : PMgrGlyph;
 var e : integer;
 begin
   new (result);
   FillByte(Result^,SizeOf(Result),0);
-  result^.character := c;
-  result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, ord(c));
+  result^.character := unicodechar(c);
+  result^.GlyphIndex := FT_Get_Char_Index (CurFont.font, c);
   //WriteFT_Face(CurFont.Font);
   e := FT_Load_Glyph (CurFont.font, result^.GlyphIndex, FT_Load_Default);
   if e <> 0 then
@@ -548,7 +567,7 @@ begin
   CurSize^.Glyphs.Add (result);
 end;
 
-function TFontManager.GetGlyph (c : char) : PMgrGlyph;
+function TFontManager.GetGlyph (c : cardinal) : PMgrGlyph;
 var r : integer;
 begin
   With CurSize^ do
@@ -556,7 +575,7 @@ begin
     r := Glyphs.Count;
     repeat
       dec (r)
-    until (r < 0) or (PMgrGlyph(Glyphs[r])^.character = c);
+    until (r < 0) or (PMgrGlyph(Glyphs[r])^.character = unicodechar(c));
     if r < 0 then
       result := CreateGlyph (c)
     else
@@ -571,10 +590,48 @@ begin
 end;
 
 function TFontManager.MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+
+Var
+  T : Array of cardinal;
+  C,I : Integer;
+
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,Length(Text));
+  For I:=1 to Length(Text) do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Angle,Result);
+end;
+
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+
+Var
+  T : Array of cardinal;
+  c,I : Integer;
+
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TUnicodeStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,C);
+  For I:=1 to c do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Angle,Result);
+end;
+
+
+procedure TFontManager.DoMakeString(Text: Array of cardinal; angle:real; ABitmaps : TBaseStringBitmaps);
+
 var g : PMgrGlyph;
     bm : PFT_BitmapGlyph;
     gl : PFT_Glyph;
-    prevIndex, prevx, c, r, rx : integer;
+    prevIndex, prevx, r, rx : integer;
     pre, adv, pos, kern : FT_Vector;
     buf : PByteArray;
     reverse : boolean;
@@ -582,19 +639,15 @@ var g : PMgrGlyph;
     FBM : PFontBitmap;
 
 begin
-  CurFont := GetFont(FontID);
   if  (Angle = 0) or   // no angle asked, or can't work with angles (not scalable)
       ((CurFont.Font^.face_flags and FT_FACE_FLAG_SCALABLE)=0) then
-    result := MakeString (FontID, Text, Size)
+    DoMakeString (Text, ABitmaps)
   else
     begin
-    InitMakeString (FontID, Size);
-    c := length(text);
-    result := TStringBitmaps.Create(c);
     if (CurRenderMode = FT_RENDER_MODE_MONO) then
-      result.FMode := btBlackWhite
+      ABitmaps.FMode := btBlackWhite
     else
-      result.FMode := bt256Gray;
+      ABitmaps.FMode := bt256Gray;
     MakeTransformation (angle, trans);
     prevIndex := 0;
     prevx := 0;
@@ -602,10 +655,10 @@ begin
     pos.y := 0;
     pre.x := 0;
     pre.y := 0;
-    for r := 0 to c-1 do
+    for r := 0 to Length(Text)-1 do
       begin
       // retrieve loaded glyph
-      g := GetGlyph (Text[r+1]);
+      g := GetGlyph (Text[r]);
       // check kerning
       if UseKerning and (g^.glyphindex <>0) and (PrevIndex <> 0) then
         begin
@@ -625,7 +678,7 @@ begin
       FTCheck(FT_Glyph_To_Bitmap (gl, CurRenderMode, nil, true),sErrMakingString4);
       // Copy what is needed to record
       bm := PFT_BitmapGlyph(gl);
-      FBM:=result.Bitmaps[r];
+      FBM:=ABitmaps.Bitmaps[r];
       with FBM^ do
         begin
         with gl^.advance do
@@ -675,36 +728,68 @@ begin
       // finish rendered glyph
       FT_Done_Glyph (gl);
       end;
-    result.FText := Text;
-    result.CalculateGlobals;
+    ABitmaps.CalculateGlobals;
     end;
 end;
 
 function TFontManager.MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+
+Var
+  T : Array of Cardinal;
+  C,I : Integer;
+  
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,Length(Text));
+  For I:=1 to Length(Text) do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Result);
+end;
+
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+
+Var
+  T : Array of Cardinal;
+  C,I : Integer;
+  
+begin
+  CurFont := GetFont(FontID);
+  InitMakeString (FontID, Size);
+  c := length(text);
+  result := TUnicodeStringBitmaps.Create(c);
+  result.FText := Text;
+  SetLength(T,C);
+  For I:=1 to C do
+    T[I-1]:=Ord(Text[i]);
+  DoMakeString(T,Result);
+end;
+
+Procedure TFontManager.DoMakeString (Text : Array of cardinal; ABitmaps  : TBaseStringBitmaps);
+
 var g : PMgrGlyph;
     bm : PFT_BitmapGlyph;
     gl : PFT_Glyph;
-    e, prevIndex, prevx, c, r, rx : integer;
+    e, prevIndex, prevx, r, rx : integer;
     pos, kern : FT_Vector;
     buf : PByteArray;
     reverse : boolean;
 begin
-  CurFont := GetFont(FontID);
-  InitMakeString (FontID, Size);
-  c := length(text);
-  result := TStringBitmaps.Create(c);
   if (CurRenderMode = FT_RENDER_MODE_MONO) then
-    result.FMode := btBlackWhite
+    ABitmaps.FMode := btBlackWhite
   else
-    result.FMode := bt256Gray;
+    ABitmaps.FMode := bt256Gray;
   prevIndex := 0;
   prevx := 0;
   pos.x := 0;
   pos.y := 0;
-  for r := 0 to c-1 do
+  for r := 0 to length(text)-1 do
     begin
     // retrieve loaded glyph
-    g := GetGlyph (Text[r+1]);
+    g := GetGlyph (Text[r]);
     // check kerning
     if UseKerning and (g^.glyphindex <>0) and (PrevIndex <> 0) then
       begin
@@ -719,7 +804,7 @@ begin
     FTCheck(FT_Glyph_To_Bitmap (gl, CurRenderMode, @pos, true),sErrMakingString4);
     // Copy what is needed to record
     bm := PFT_BitmapGlyph(gl);
-    with result.Bitmaps[r]^ do
+    with ABitmaps.Bitmaps[r]^ do
       begin
       with gl^.advance do
         begin
@@ -761,8 +846,7 @@ begin
     // finish rendered glyph
     FT_Done_Glyph (gl);
     end;
-  result.FText := Text;
-  result.CalculateGlobals;
+  ABitmaps.CalculateGlobals;
 end;
 
 function TFontManager.GetString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
@@ -795,6 +879,36 @@ begin
   result := MakeString (FontID, text, Size);
 end;
 
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+// Black and white
+begin
+  CurRenderMode := FT_RENDER_MODE_MONO;
+  result := MakeString (FontID, text, Size, angle);
+end;
+
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+// Anti Aliased gray scale
+begin
+  CurRenderMode := FT_RENDER_MODE_NORMAL;
+  result := MakeString (FontID, text, Size, angle);
+end;
+
+{ Procedures without angle have own implementation to have better speed }
+
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+// Black and white, following the direction of the font (left to right, top to bottom, ...)
+begin
+  CurRenderMode := FT_RENDER_MODE_MONO;
+  result := MakeString (FontID, text, Size);
+end;
+
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+// Anti Aliased gray scale, following the direction of the font (left to right, top to bottom, ...)
+begin
+  CurRenderMode := FT_RENDER_MODE_NORMAL;
+  result := MakeString (FontID, text, Size);
+end;
+
 function TFontManager.RequestFont (afilename:string) : integer;
 begin
   result := RequestFont (afilename,0);
@@ -821,17 +935,17 @@ end;
 
 { TStringBitmaps }
 
-function TStringBitmaps.GetCount : integer;
+function TBaseStringBitmaps.GetCount : integer;
 begin
   result := FList.Count;
 end;
 
-function TStringBitmaps.GetBitmap (index:integer) : PFontBitmap;
+function TBaseStringBitmaps.GetBitmap (index:integer) : PFontBitmap;
 begin
   result := PFontBitmap(FList[index]);
 end;
 
-constructor TStringBitmaps.Create (ACount : integer);
+constructor TBaseStringBitmaps.Create (ACount : integer);
 var r : integer;
     bm : PFontBitmap;
 begin
@@ -846,7 +960,7 @@ begin
     end;
 end;
 
-destructor TStringBitmaps.destroy;
+destructor TBaseStringBitmaps.destroy;
 var r : integer;
     bm : PFontBitmap;
 begin
@@ -868,7 +982,7 @@ begin
 end;
 *)
 
-procedure TStringBitmaps.CalculateGlobals;
+procedure TBAseStringBitmaps.CalculateGlobals;
 var
   l,r : integer;
 
@@ -907,7 +1021,7 @@ begin
     end;
 end;
 
-procedure TStringBitmaps.GetBoundRect (out aRect : TRect);
+procedure TBaseStringBitmaps.GetBoundRect (out aRect : TRect);
 begin
   aRect := FBounds;
 end;

packages/fcl-image/src/ftfont.pp

@@ -27,12 +27,13 @@ type
   private
     FResolution : longword;
     FAntiAliased : boolean;
-    FLastText : TStringBitmaps;
+    FLastText : TBaseStringBitmaps;
     FIndex, FFontID : integer;
     FFace : PFT_Face;
     FAngle : real;
     procedure ClearLastText;
   protected
+    procedure DrawLastText (atX,atY:integer);
     procedure DrawChar (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
     procedure DrawCharBW (x,y:integer; data:PByteArray; pitch, width, height:integer); virtual;
     procedure SetName (AValue:string); override;
@@ -47,7 +48,12 @@ type
     procedure DoGetTextSize (text:string; var w,h:integer); override;
     function DoGetTextHeight (text:string) : integer; override;
     function DoGetTextWidth (text:string) : integer; override;
+    procedure DoDrawText (atx,aty:integer; atext: unicodestring); override;
+    procedure DoGetTextSize (text:unicodestring; var w,h:integer); override;
+    function DoGetTextHeight (text:unicodestring) : integer; override;
+    function DoGetTextWidth (text: unicodestring) : integer; override;
     procedure GetText (aText:string);
+    procedure GetText (aText:unicodestring);
     procedure GetFace;
   public
     constructor create; override;
@@ -180,6 +186,36 @@ begin
     result := right - left;
 end;
 
+procedure TFreeTypeFont.DoGetTextSize (text:unicodestring; var w,h:integer);
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    begin
+    w := right - left;
+    h := top - bottom;
+    end;
+end;
+
+function TFreeTypeFont.DoGetTextHeight (text:unicodestring) : integer;
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    result := top - bottom;
+end;
+
+function TFreeTypeFont.DoGetTextWidth (text:unicodestring) : integer;
+var r : TRect;
+begin
+  GetText (text);
+  FLastText.GetBoundRect (r);
+  with r do
+    result := right - left;
+end;
+
 procedure TFreeTypeFont.SetFlags (index:integer; AValue:boolean);
 begin
   if not (index in [5,6]) then   // bold,italic
@@ -213,7 +249,39 @@ var b : boolean;
 begin
   if assigned (FLastText) then
     begin
-    if CompareStr(FLastText.Text,aText) <> 0 then
+    if FLastText.InheritsFrom(TUnicodeStringBitmaps) or  (CompareStr(TStringBitMaps(FLastText).Text,aText) <> 0) then
+      begin
+      FLastText.Free;
+      b := true;
+      end
+    else
+      begin
+      if FAntiAliased then
+        b := (FLastText.mode <> bt256Gray)
+      else
+        b := (FLastText.mode <> btBlackWhite);
+      if b then
+        FLastText.Free;
+      end;
+    end
+  else
+    b := true;
+  if b then
+    begin
+    FontMgr.Resolution := FResolution;
+    if FAntiAliased then
+      FLastText := FontMgr.GetStringGray (FFontId, aText, Size, Angle)
+    else
+      FLastText := FontMgr.GetString (FFontId, aText, Size, Angle);
+    end;
+end;
+
+procedure TFreeTypeFont.GetText (aText:Unicodestring);
+var b : boolean;
+begin
+  if assigned (FLastText) then
+    begin
+    if FLastText.InheritsFrom(TStringBitmaps) or  (TUnicodeStringBitMaps(FLastText).Text<>aText) then
       begin
       FLastText.Free;
       b := true;
@@ -240,10 +308,25 @@ begin
     end;
 end;
 
+procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:unicodestring);
+
+begin
+  GetText (atext);
+  DrawLastText(atX,atY);
+end;
+
 procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:string);
-var r : integer;
+
 begin
   GetText (atext);
+  DrawLastText(atX,atY);
+end;
+
+procedure TFreeTypeFont.DrawLastText (atX,atY:integer);
+
+var r : integer;
+
+begin
   with FLastText do
     for r := 0 to count-1 do
       with Bitmaps[r]^ do