Hi,
I've made a little app that should shine some more light in what is happening. If you prefer a precompiled exe, you can get it from here:
https://download.tmssoftware.com/flexcel/samples/fontinspector.zip
Or if you want to compile it, the source code is at the end of this post. Please let me know the results: This app will scan all the fonts in the font folder, report if a font is defined twice (what I believe is that you might have a "correct" calibri, but also a "restricted" calibri in the same folder, and FlexCel is using the restricted one). It also will report which files in the c:\windows\fonts folder are "restricted" (so you can't embed them legally).
If, as I suspect, what happens is that there is more than one "calibri" in the font folder, I will fix the FlexCel code to prefer the latest versions of repeated fonts, and also those that aren't restricted. But removing those restricted files on your side should also work. (just open an admin command line and type del filename reported by the app on the files that are restricted and you don't want.
program fontinspector;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
FlexCel.VCLSupport,
_PdfTrueType.TPdfTrueType,
_PdfTrueType.TFontDataReader,
_PdfTrueType.TChunkByteArray,
_UIClasses.TUIFont,
_PdfFontFactory.PdfFontFactory,
_UIClasses.TUIFontStyle,
__FlexCelTypes,
Generics.Collections,
Types,
IOUtils,
Classes,
_PdfTrueType.TTrueTypeInfo,
_PdfConsts.TPdfFontFolderNotFoundAction,
_PdfFontFactory.TPsFontList,
_PdfFontFactory.StringHash
;
var
AllFonts: TDictionary<string, string>;
DuplicatedFonts: TList<string>;
RestrictedFonts: TList<string>;
function MakeHash(const name: UTF16String; const style: TUIFontStyleSet): UTF16String;
var
s: UTF16String;
begin
s := name;
if (TUIFontStyle.fsBold in style) then
s:= s + '-bold-';
if (TUIFontStyle.fsItalic in style) then
s:= s + '-italic-';
Result := s;
end;
procedure LoadFontInternal(const path: UTF16String; const b: TFontDataReader; const OwnsFontData: boolean);
var
ttfs: TTrueTypeInfoArray;
ttf: TTrueTypeInfo;
LocFamilyName: UTF16String;
FontName, ExistingFontPath: string;
pdfdef: TPdfTrueType;
begin
ttfs := TPdfTrueType.GetColection(b, OwnsFontData);
for ttf in ttfs do
begin
for LocFamilyName in ttf.FamilyNames do
begin
pdfdef := TPdfTrueType.Create(b, LocFamilyName, OwnsFontData);
try
if pdfdef.EmbedForbidden then RestrictedFonts.Add(path);
finally
pdfdef.Free;
end;
FontName := MakeHash(LocFamilyName, TTrueTypeInfo.GetStyle(ttf.FontFlags));
if (AllFonts.TryGetValue(FontName, ExistingFontPath)) then
begin
DuplicatedFonts.Add('Duplicated Font: ' + FontName + ' is defined in "' + ExistingFontPath + '" and "' + path + '"');
end
else
begin
AllFonts.Add(FontName, path);
end;
end;
end;
end;
procedure LoadFont(const path: UTF16String; const b: TFontDataReader; const OwnsFontData: boolean);
var
fs: TFileStream;
begin
fs := TFileStream.Create(path, FileMode.Open);
try
b.Reset(fs);
LoadFontInternal(path, b, OwnsFontData);
finally
FreeObj(fs);
end;
end;
procedure LoadAllFonts(const FontPath: UTF16String; const FontExtension: UTF16String);
var
FontPathArray: TArray<UTF16String>;
fp: UTF16String;
fi: TStringDynArray;
FontDataReader: TFontDataReader;
fontFile: UTF16String;
begin
FontPathArray := StrSplit(FontPath, ';');
for fp in FontPathArray do
begin
if String_IsNullOrEmpty(fp) then
continue;
if fp = TPath.DirectorySeparatorChar then
continue;
if not TDirectory.Exists(fp) then
begin
WriteLn('Folder not found: ' + fp);
continue;
end;
fi := TDirectory.GetFiles(fp, FontExtension, TSearchOption.soAllDirectories);
FontDataReader := TFontDataReader.Create;
try
for fontFile in fi do
begin
case SwitchString(String_ToLowerInvariant(TPath.GetExtension(fontFile))) of
Int32($2E747463) {'.ttc'}, Int32($2E6F7466) {'.otf'}, Int32($2E747466) {'.ttf'}:
begin
end;
else
begin
continue;
end;
end;
try
LoadFont(fontFile, FontDataReader, false);
except
on ex: Exception do
begin
//Invalid font. nothing to do, just continue reading the other fonts.
// What we will do is just ignore it here, and throw an exception when (and if) the user actually tries to use this font.
WriteLn('Invalid font: ' + fontfile);
end;
end;
end;
finally
FreeObj(FontDataReader);
end;
end;
end;
procedure WriteInfo;
var
f: string;
begin
if DuplicatedFonts.Count = 0 then WriteLn('There are no duplicated fonts.')
else
begin
WriteLn('**** Duplicated Fonts ****');
for f in DuplicatedFonts do Writeln(f);
end;
WriteLn;
if RestrictedFonts.Count = 0 then WriteLn('There are no restricted fonts.')
else
begin
WriteLn('**** Restricted Fonts ****');
for f in RestrictedFonts do Writeln(f);
WriteLn;
end;
end;
var
FontPath: string;
begin
if ParamCount < 1 then FontPath := 'C:\Windows\Fonts' else FontPath := ParamStr(1);
AllFonts := TDictionary<string, string>.Create;
try
RestrictedFonts := TList<string>.Create;
try
DuplicatedFonts := TList<string>.Create;
try
LoadAllFonts(FontPath, '*.?t?');
WriteInfo;
finally
DuplicatedFonts.Free;
end;
finally
RestrictedFonts.Free;
end;
finally
AllFonts.Free;
end;
ReadLn;
end.