从文件名取得字体名称函数
function GetFontNameFromFotFile(const ttf: string): string;
var
FHd: integer;
FotFile: string;
FontName: string;
ch:char;
begin
FontName:='';
try
FotFile := ChangeFileExt(ttf, '.fot');
CreateScalableFontResource(0, PChar(FotFile), PChar(ttf), nil);
if fileexists(FotFile) then
begin
try
FHd := FileOpen(FotFile,fmShareExclusive OR fmOpenRead);
if FHd >0 then
begin
if FileSeek(FHd, 1270, 0)=-1 then
ShowMessage('Error: FileSeek operation with file'+FotFile)
else
begin
FileRead(FHd,ch,1);
while ch<>#0 do
begin
FileRead(FHd,ch,1);
end;
FileRead(FHd,ch,1);
while ch<>#0 do
begin
FontName:=FontName+ch;
FileRead(FHd,ch,1);
end;
end;
end
else
begin
ShowMessage('Error: File '+FotFile+' not opened');
end;
finally
if FHd>0 then FileClose(FHd);
end;
end
else
ShowMessage('FOT-file not created');
finally
if FileExists(FotFile) then DeleteFile(FotFile);
end;
Result := FontName;
end;