paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:09:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add (Get|Find)PostScriptFontName

Browse Source 
git-svn-id: trunk@41553 -
This commit is contained in:
michael 2019-03-02 14:05:23 +00:00
parent d1dae0423c
commit d8773e156a
1 changed files with 57 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -85,6 +85,7 @@ type
TFPFontCacheItemArray = Array of TFPFontCacheItem;
{ TFPFontCacheList }
EFontNotFound = Class(Exception);
TFPFontCacheList = class(TObject)
private
@ -97,6 +98,7 @@ type
{ Set any / or \ path delimiters to the OS specific delimiter }
procedure FixPathDelimiters;
protected
function DoFindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean; Out aBaseFont : TFPFontCacheItem): String;
function GetCount: integer; virtual;
function GetItem(AIndex: Integer): TFPFontCacheItem; virtual;
procedure SetItem(AIndex: Integer; AValue: TFPFontCacheItem); virtual;
@ -111,6 +113,10 @@ type
procedure ReadStandardFonts;
property Count: integer read GetCount;
function IndexOf(const AObject: TFPFontCacheItem): integer;
// Find postscript font name based on fontname and attributes
function FindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String;
// Same as Find, but raise exception when not found.
function GetPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String;
function Find(const AFontCacheItem: TFPFontCacheItem): integer; overload;
function Find(const AFamilyName: string; ABold: boolean; AItalic: boolean): TFPFontCacheItem; overload;
function Find(const APostScriptName: string): TFPFontCacheItem; overload;
@ -143,6 +149,7 @@ resourcestring
rsNoSearchPathDefined = 'No search path was defined';
rsNoFontFileName = 'The FileName property is empty, so we can''t load font data.';
rsMissingFontFile = 'The font file <%s> can''t be found.';
SErrFontNotFound = 'The font <%s> can can''t be found';
var
uFontCacheList: TFPFontCacheList;
@ -591,6 +598,56 @@ begin
Result := FList.IndexOf(AObject);
end;
function TFPFontCacheList.GetPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String;
Var
lFC : TFPFontCacheItem;
lMissingFontName : String;
begin
Result:=DoFindPostScriptFontName(aFontName,aBold,aItalic,lfc);
if (Result=aFontName) and (aBold or aItalic) then
begin
if lFC<>Nil then
lMissingFontName := lfc.FamilyName
else
lMissingFontName := aFontName;
if (aBold and AItalic) then
lMissingFontName := lMissingFontName + '-BoldItalic'
else if aBold then
lMissingFontName := lMissingFontName + '-Bold'
else if aItalic then
lMissingFontName := lMissingFontName + '-Italic';
raise EFontNotFound.CreateFmt(SErrFontNotFound, [lMissingFontName]);
end;
end;
function TFPFontCacheList.FindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean): String;
Var
lFC : TFPFontCacheItem;
begin
Result:=DoFindPostScriptFontName(aFontName,aBold,aItalic,lfc);
end;
function TFPFontCacheList.DoFindPostScriptFontName(const AFontName: string; ABold: boolean; AItalic: boolean; Out aBaseFont : TFPFontCacheItem): String;
Var
lNewFC : TFPFontCacheItem;
begin
Result:=aFontName;
aBaseFont := FindFont(aFontName);
if not Assigned(aBaseFont) then
exit;
// find corresponding font style (bold and/or italic)
lNewFC := Find(aBaseFont.FamilyName, aBold, aItalic);
if not Assigned(lNewFC) then
exit;
Result := lNewFC.PostScriptName;
end;
function TFPFontCacheList.Find(const AFontCacheItem: TFPFontCacheItem): integer;
var
i: integer;