* freetype: support floating-point font sizes

git-svn-id: trunk@43293 -

packages/fcl-image/examples/textout.pp

@@ -50,6 +50,8 @@ begin
       Font.FPColor:=colBlack;
       S:='Hello, world!';
       Canvas.TextOut(20,20,S);
+      F.Size := 14.5;
+      Canvas.TextOut(20,30,S);
       U:=UTF8Decode('привет, Мир!');
       Font.FPColor:=colBlue;
       Canvas.TextOut(50,50,U);

packages/fcl-image/src/freetype.pp

@@ -135,11 +135,11 @@ type
       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;
+      procedure InitMakeString (FontID, Size:real);
+      function MakeString (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
+      function MakeString (FontId:integer; Text:string; Size:real) : TStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; size:real; angle:real) : TUnicodeStringBitmaps;
+      function MakeString (FontId:integer; Text:Unicodestring; Size:real) : TUnicodeStringBitmaps;
     public
       constructor Create;
       destructor destroy; override;
@@ -147,17 +147,17 @@ type
       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;
+      function GetString (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; size:real; 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;
+      function GetStringGray (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:unicodestring; size:real; 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;
+      function GetString (FontId:integer; Text:string; Size:real) : TStringBitmaps;
+      function GetString (FontId:integer; Text:Unicodestring; Size:real) : 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:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+      function GetStringGray (FontId:integer; Text: String; Size:real) : TStringBitmaps;
+      function GetStringGray (FontId:integer; Text:Unicodestring; Size:real) : 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;
@@ -518,8 +518,7 @@ procedure TFontManager.SetPixelSize (aSize, aResolution : integer);
       end;
   end;
 
-var s : longint;
-    Err : integer;
+var Err : integer;
 
 begin
   with Curfont, Font^ do
@@ -532,8 +531,7 @@ begin
       end
     else
       begin
-      s := aSize shl 6;
-      Err := FT_Set_char_size (Font, s, s, aResolution, aResolution);
+      Err := FT_Set_char_size (Font, aSize, aSize, aResolution, aResolution);
       if Err <> 0 then
         FTError (format(sErrSetCharSize,[aSize,aResolution]), Err);
       end;
@@ -587,13 +585,13 @@ begin
     end;
 end;
 
-procedure TFontManager.InitMakeString (FontID, Size:integer);
+procedure TFontManager.InitMakeString (FontID, Size:real);
 begin
-  GetSize (size,Resolution);
+  GetSize (round(size*64),Resolution);
   UseKerning := ((Curfont.font^.face_flags and FT_FACE_FLAG_KERNING) <> 0);
 end;
 
-function TFontManager.MakeString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+function TFontManager.MakeString (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
 
 Var
   T : Array of cardinal;
@@ -613,7 +611,7 @@ begin
   DoMakeString(T,Angle,Result);
 end;
 
-function TFontManager.MakeString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; size:real; angle:real) : TUnicodeStringBitmaps;
 
 Var
   T : Array of cardinal;
@@ -738,7 +736,7 @@ begin
     end;
 end;
 
-function TFontManager.MakeString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+function TFontManager.MakeString (FontId:integer; Text:string; Size:real) : TStringBitmaps;
 
 Var
   T : Array of Cardinal;
@@ -758,7 +756,7 @@ begin
   DoMakeString(T,Result);
 end;
 
-function TFontManager.MakeString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+function TFontManager.MakeString (FontId:integer; Text:Unicodestring; Size:real) : TUnicodeStringBitmaps;
 
 Var
   T : Array of Cardinal;
@@ -857,14 +855,14 @@ begin
   ABitmaps.CalculateGlobals;
 end;
 
-function TFontManager.GetString (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+function TFontManager.GetString (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
 // Black and white
 begin
   CurRenderMode := FT_RENDER_MODE_MONO;
   result := MakeString (FontID, text, Size, angle);
 end;
 
-function TFontManager.GetStringGray (FontId:integer; Text:string; size:integer; angle:real) : TStringBitmaps;
+function TFontManager.GetStringGray (FontId:integer; Text:string; size:real; angle:real) : TStringBitmaps;
 // Anti Aliased gray scale
 begin
   CurRenderMode := FT_RENDER_MODE_NORMAL;
@@ -873,28 +871,28 @@ end;
 
 { Procedures without angle have own implementation to have better speed }
 
-function TFontManager.GetString (FontId:integer; Text:string; Size:integer) : TStringBitmaps;
+function TFontManager.GetString (FontId:integer; Text:string; Size:real) : TStringBitmaps;
 // 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:string; Size:integer) : TStringBitmaps;
+function TFontManager.GetStringGray (FontId:integer; Text:string; Size:real) : TStringBitmaps;
 // 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.GetString (FontId:integer; Text:Unicodestring; size:integer; angle:real) : TUnicodeStringBitmaps;
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; size:real; 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;
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; size:real; angle:real) : TUnicodeStringBitmaps;
 // Anti Aliased gray scale
 begin
   CurRenderMode := FT_RENDER_MODE_NORMAL;
@@ -903,14 +901,14 @@ end;
 
 { Procedures without angle have own implementation to have better speed }
 
-function TFontManager.GetString (FontId:integer; Text:Unicodestring; Size:integer) : TUnicodeStringBitmaps;
+function TFontManager.GetString (FontId:integer; Text:Unicodestring; Size:real) : 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;
+function TFontManager.GetStringGray (FontId:integer; Text:Unicodestring; Size:real) : TUnicodeStringBitmaps;
 // Anti Aliased gray scale, following the direction of the font (left to right, top to bottom, ...)
 begin
   CurRenderMode := FT_RENDER_MODE_NORMAL;

packages/fcl-image/src/ftfont.pp

@@ -20,7 +20,7 @@ interface
 {$DEFINE DYNAMIC}
 
 uses
-  SysUtils, Classes, FPCanvas, fpimgcmn,
+  SysUtils, Classes, FPCanvas, fpimgcmn, math,
   {$IFDEF DYNAMIC}freetypehdyn{$ELSE} freetypeh{$ENDIF},
   freetype;
 
@@ -35,15 +35,18 @@ type
     FLastText : TBaseStringBitmaps;
     FIndex, FFontID : integer;
     FFace : PFT_Face;
+    FRealSize: real;
     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 SetAngle(const aAngle: real); virtual;
     procedure SetName (AValue:string); override;
     procedure SetIndex (AValue : integer);
     procedure SetSize (AValue : integer); override;
+    procedure SetRealSize(ARealSize : real); virtual;
     function GetFlags (index:integer) : boolean; override;
     procedure SetFlags (index:integer; AValue:boolean); override;
     procedure DoAllocateResources; override;
@@ -61,12 +64,13 @@ type
     procedure GetText (aText:unicodestring);
     procedure GetFace;
   public
-    constructor create; override;
+    constructor Create; override;
     destructor Destroy; override;
     property FontIndex : integer read FIndex write SetIndex;
     property Resolution : longword read FResolution write FResolution;
     property AntiAliased : boolean read FAntiAliased write FAntiAliased;
-    property Angle : real read FAngle write FAngle;
+    property Size : real read FRealSize write SetRealSize;
+    property Angle : real read FAngle write SetAngle;
   end;
 
 var
@@ -98,6 +102,7 @@ begin
   FFontID := -1;
   FAntiAliased := True;
   FResolution := DefaultResolution;
+  FRealSize := Size;
 end;
 
 destructor TFreeTypeFont.Destroy;
@@ -128,6 +133,14 @@ begin
     FFontID := FontMgr.RequestFont(Name, FIndex);
 end;
 
+procedure TFreeTypeFont.SetRealSize(ARealSize: real);
+begin
+  if SameValue(FRealSize, ARealSize) then Exit;
+  ClearLastText;
+  inherited Size := Round(ARealSize);
+  FRealSize := ARealSize;
+end;
+
 procedure TFreeTypeFont.SetIndex (AValue : integer);
 begin
   FIndex := AValue;
@@ -140,6 +153,7 @@ procedure TFreeTypeFont.SetSize (AValue : integer);
 begin
   ClearLastText;
   inherited;
+  FRealSize := inherited Size;
 end;
 
 procedure TFreeTypeFont.ClearLastText;
@@ -254,7 +268,7 @@ var b : boolean;
 begin
   if assigned (FLastText) then
     begin
-    if FLastText.InheritsFrom(TUnicodeStringBitmaps) or  (CompareStr(TStringBitMaps(FLastText).Text,aText) <> 0) then
+    if not (FLastText.InheritsFrom(TStringBitMaps) and (CompareStr(TStringBitMaps(FLastText).Text,aText) = 0)) then
       begin
       FLastText.Free;
       b := true;
@@ -275,9 +289,9 @@ begin
     begin
     FontMgr.Resolution := FResolution;
     if FAntiAliased then
-      FLastText := FontMgr.GetStringGray (FFontId, aText, Size, Angle)
+      FLastText := FontMgr.GetStringGray (FFontId, aText, FRealSize, Angle)
     else
-      FLastText := FontMgr.GetString (FFontId, aText, Size, Angle);
+      FLastText := FontMgr.GetString (FFontId, aText, FRealSize, Angle);
     end;
 end;
 
@@ -286,7 +300,7 @@ var b : boolean;
 begin
   if assigned (FLastText) then
     begin
-    if FLastText.InheritsFrom(TStringBitmaps) or  (TUnicodeStringBitMaps(FLastText).Text<>aText) then
+    if not (FLastText.InheritsFrom(TUnicodeStringBitMaps) and (TUnicodeStringBitMaps(FLastText).Text=aText)) then
       begin
       FLastText.Free;
       b := true;
@@ -307,12 +321,19 @@ begin
     begin
     FontMgr.Resolution := FResolution;
     if FAntiAliased then
-      FLastText := FontMgr.GetStringGray (FFontId, aText, Size, Angle)
+      FLastText := FontMgr.GetStringGray (FFontId, aText, FRealSize, Angle)
     else
-      FLastText := FontMgr.GetString (FFontId, aText, Size, Angle);
+      FLastText := FontMgr.GetString (FFontId, aText, FRealSize, Angle);
     end;
 end;
 
+procedure TFreeTypeFont.SetAngle(const aAngle: real);
+begin
+  if FAngle = aAngle then Exit;
+  ClearLastText;
+  FAngle := aAngle;
+end;
+
 procedure TFreeTypeFont.DoDrawText (atX,atY:integer; atext:unicodestring);
 
 begin