paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 16:10:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

* freetype: support floating-point font sizes

Browse Source 
git-svn-id: trunk@43293 -
This commit is contained in:
ondrej 2019-10-21 17:14:06 +00:00
parent 763b3a96ab
commit e265a8a2d6
3 changed files with 61 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-image/examples/textout.pp
View File

@ -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);

60
packages/fcl-image/src/freetype.pp
View File

@ -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;

39
packages/fcl-image/src/ftfont.pp
View File

@ -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