نصب فونت

[m.amiri]

سلام
من مي خوام يه فونت اول برنامم نصب كنم اما مسير نصب ويندوز يا پوشه ي فونت
رو نمي تونم پيدا كنم

لطفا بگين چطوري اين كارو بكنم *ممنونم*

[Mask]

از روال زیر استفاده کنید.

procedure InstallFont(PathDirFontLocal: String);
var
F : TSearchRec;
FileName : TFileName;
i:Byte;
List:TStringList;
DirFontSystem :string;
DirWin: array [0..MAX_PATH] of Char;
begin
try
GetWindowsDirectory(DirWin, MAX_PATH);
DirFontSystem :=strpas(DirWin)+'\Fonts\';
PathDirFontLocal:=IncludeTrailingBackslash(PathDir FontLocal);
List:=TStringList.Create;
try
if DirectoryExists(PathDirFontLocal)then
begin
if (FindFirst(PathDirFontLocal + '*.*',faAnyFile - faDirectory,F) = 0)then
begin
try
repeat
FileName := F.Name;
List.Add(F.Name)
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
for i:=0 to List.Count-1 do
begin
FileSetAttr(PathDirFontLocal +List[i], faArchive);
AddFontResource(pchar(PathDirFontLocal+List[i]));
CopyFile(pchar(PathDirFontLocal+List[i]),pchar(DirFontSystem + List[i]),false);
SendMessage(HWND_BROADCAST,WM_FONTCHANGE, 0, 0 );
end;
end;
finally
List.Free;
end;
except
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
InstallFont(ExtractFilePath(Application.ExeName)+' Fonts');
end;