diff --git a/packages/fcl-image/examples/textout.pp b/packages/fcl-image/examples/textout.pp index db83d7a63b..a0725f3a56 100644 --- a/packages/fcl-image/examples/textout.pp +++ b/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); diff --git a/packages/fcl-image/src/freetype.pp b/packages/fcl-image/src/freetype.pp index 9a37d55237..f3d818013a 100644 --- a/packages/fcl-image/src/freetype.pp +++ b/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; diff --git a/packages/fcl-image/src/ftfont.pp b/packages/fcl-image/src/ftfont.pp index cad391faa8..47125ad76e 100644 --- a/packages/fcl-image/src/ftfont.pp +++ b/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