paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-21 12:46:31 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Ondrej Pokorny (bug ID 29987)

Browse Source 
- utf8string-aware TFPFontCacheItem.TextWidth (utf16 surrogate pairs aren't supported though)
  - Cached result for TFPFontCacheItem.GetFontData. 
  - Fix for range check error in TTFFileInfo.PrepareFontDefinition.

git-svn-id: trunk@33468 -
This commit is contained in:
michael 2016-04-10 10:32:54 +00:00
parent b7a76bd3ab
commit fb87b6bc9c
2 changed files with 46 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
packages/fcl-pdf/src/fpparsettf.pp
View File

@ -807,7 +807,8 @@ begin
FMissingWidth := Widths[Chars[CharCodes^[32]]].AdvanceWidth; // Char(32) - Space character
for I:=0 to 255 do
begin
if (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
if (CharCodes^[i]>=0) and (CharCodes^[i]<=High(Chars))
and (Widths[Chars[CharCodes^[i]]].AdvanceWidth> 0) and (CharNames^[i]<> '.notdef') then
CharWidth[I]:= ToNatural(Widths[Chars[CharCodes^[I]]].AdvanceWidth)
else
CharWidth[I]:= FMissingWidth;

70
packages/fcl-pdf/src/fpttf.pp
View File

@ -43,22 +43,25 @@ type
FFamilyName: String;
FFileName: String;
FStyleFlags: LongWord;
FFileInfo: TTFFileInfo;
FOwner: TFPFontCacheList; // reference to FontCacheList that owns this instance
function GetIsBold: boolean;
function GetIsFixedWidth: boolean;
function GetIsItalic: boolean;
function GetIsRegular: boolean;
procedure SetFileName(const AFileName: String);
procedure SetIsBold(AValue: boolean);
procedure SetIsFixedWidth(AValue: boolean);
procedure SetIsItalic(AValue: boolean);
procedure SetIsRegular(AValue: boolean);
public
constructor Create(const AFilename: String);
{ Returns the actual TTF font file information. Caller needs to free the returned instance. }
destructor Destroy; override;
{ Returns the actual TTF font file information. }
function GetFontData: TTFFileInfo;
{ Result is in pixels }
function TextWidth(AStr: string; APointSize: single): single;
property FileName: String read FFileName write FFileName;
function TextWidth(AStr: utf8string; APointSize: single): single;
property FileName: String read FFileName write SetFileName;
property FamilyName: String read FFamilyName write FFamilyName;
{ A bitmasked value describing the full font style }
property StyleFlags: LongWord read FStyleFlags write FStyleFlags;
@ -108,6 +111,7 @@ implementation
resourcestring
rsNoSearchPathDefined = 'No search path was defined';
rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
rsCharAboveWord = 'TextWidth doesn''t support characters higher then High(Word) - %d.';
type
{ so we can get access to protected methods }
@ -147,6 +151,14 @@ begin
Result := (FStyleFlags and FP_FONT_STYLE_REGULAR) <> 0;
end;
procedure TFPFontCacheItem.SetFileName(const AFileName: String);
begin
if FFileName = AFileName then Exit;
FFileName := AFileName;
if FFileInfo<>nil then
FreeAndNil(FFileInfo);
end;
procedure TFPFontCacheItem.SetIsBold(AValue: boolean);
begin
if AValue then
@ -192,14 +204,25 @@ begin
FStyleFlags := FP_FONT_STYLE_REGULAR;
end;
destructor TFPFontCacheItem.Destroy;
begin
FFileInfo.Free;
inherited Destroy;
end;
function TFPFontCacheItem.GetFontData: TTFFileInfo;
begin
if FFileInfo <> nil then
Exit(FFileInfo);
if FileName = '' then
raise ETTF.Create(rsNoFontFileName);
if FileExists(FileName) then
begin
Result := TTFFileInfo.Create;
Result.LoadFromFile(FileName);
FFileInfo := TTFFileInfo.Create;
FFileInfo.LoadFromFile(FileName);
Result := FFileInfo;
end
else
Result := nil;
@ -208,7 +231,7 @@ end;
{ TextWidth returns with width of the text. If APointSize = 0.0, then it returns
the text width in Font Units. If APointSize > 0 then it returns the text width
in Pixels. }
function TFPFontCacheItem.TextWidth(AStr: string; APointSize: single): single;
function TFPFontCacheItem.TextWidth(AStr: utf8string; APointSize: single): single;
{
From Microsoft's Typography website:
Converting FUnits (font units) to pixels
@ -233,7 +256,7 @@ var
i: integer;
lWidth: integer;
lGIndex: integer;
c: Char;
us: UnicodeString;
{$IFDEF ttfdebug}
sl: TStringList;
s: string;
@ -262,25 +285,20 @@ begin
sl.Free;
{$ENDIF}
try
lWidth := 0;
for i := 1 to Length(AStr) do
begin
c := AStr[i];
lGIndex := lFntInfo.GetGlyphIndex(Ord(c));
lWidth := lWidth + lFntInfo.GetAdvanceWidth(lGIndex);
end;
if APointSize = 0.0 then
Result := lWidth
else
begin
{ Converting Font Units to Pixels. The formula is:
pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm ) }
Result := lWidth * APointSize * FOwner.DPI / (72 * lFntInfo.Head.UnitsPerEm);
end;
finally
lFntInfo.Free;
lWidth := 0;
us := UTF8Decode(AStr);
for i := 1 to Length(us) do
begin
lGIndex := lFntInfo.GetGlyphIndex(Word(us[i]));
lWidth := lWidth + lFntInfo.GetAdvanceWidth(lGIndex);
end;
if APointSize = 0.0 then
Result := lWidth
else
begin
{ Converting Font Units to Pixels. The formula is:
pixels = glyph_units * pointSize * resolution / ( 72 points per inch * THead.UnitsPerEm ) }
Result := lWidth * APointSize * FOwner.DPI / (72 * lFntInfo.Head.UnitsPerEm);
end;
end;