بدست آوردن نام سیستمی فونت

[مجتبی جوادی]

دوستان درود
چطور میشه نام سیستمی یک فایل فونت(*.ttf) را بدست آورد؟
با سپاس

[Mask]

از این مسیر

HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts

[مجتبی جوادی]

من میخوام یک فایل فونت را بگیره و نام سیسمی آنرا برگردانه که این فونت هنوز روی سیستم نصب نشده

[سعید صابری]

http://stackoverflow.com/questions/13381537/how-do-i-get-the-font-name-from-a-font-file

[مجتبی جوادی]

درود بر دوستان
من خودم جوابشو پیدا کردم . اگر کسی نظر بهتری داره راهنمایی کنه
function FontNameFromFile(const FileName:string):string;
type
TInfo=record
Fonts:TStringList;
Index:Integer;
Name:string;
end;
var
DC:HDC;
LFont:TLogFont;
Info:TInfo;
function EnumFontsProc1(const LogFont:EnumLogFontEx;const TextMetric:TTextMetric;FontType:Integer;var Info:TInfo):Integer; stdcall;
begin
Info.Fonts.Add(LogFont.elfFullName);
Result:=1;
end;
function EnumFontsProc2(const LogFont:EnumLogFontEx;const TextMetric:TTextMetric;FontType:Integer;var Info:TInfo):Integer; stdcall;
begin
if (Info.Index<Info.Fonts.Count)and(Info.Fonts[Info.Index]=LogFont.elfFullName) then begin
Result:=1;
Inc(Info.Index);
end
else begin
Result:=0;
Info.Name:=LogFont.elfFullName;
end;
end;
begin
Result:='';
DC:=GetDC(0);
try
FillChar(LFont,SizeOf(LFont),0);
LFont.lfCharset:=DEFAULT_CHARSET;
Info.Fonts:=TStringList.Create;
try
EnumFontFamiliesEx(DC,LFont,@EnumFontsProc1,Intege r(@Info),0);
if AddFontResourceEx(PChar(FileName),FR_PRIVATE,nil)= 0 then Exit;
Info.Index:=0;
EnumFontFamiliesEx(DC,LFont,@EnumFontsProc2,Intege r(@Info),0);
RemoveFontResourceEx(PChar(FileName),FR_PRIVATE,ni l);
Result:=Info.Name;
finally
Info.Fonts.Free;
end;
finally
ReleaseDC(0,DC);
end;
end;
با سپاس