نصب فونت در ویندوز 7

[Felony]

کد بالا فونت مورد نظر رو به Font Table اضافه میکنه و بعد از بسته شدن هم ویندوز به صورت خودکار حذفش میکنه ، برای اینکه فونت رو به صورت دائمی نصبش کنید باید در رجیستری ثبتش کنید ، یا توجه به مستندات MSDN کدتون رو تغییر دادم ( از اول نوشتم ! ) ولی تو 7 تستش نکردم ( رو سیستم ویندوز سرور نصب هست ) :

procedure InstallFont(LocalFontPath: String);

const

  CSIDL_Fonts = $0014;

var

  FontDir: array [0 .. MAX_PATH] of Char;

  Font: string;

  Reg: TRegistry;

begin

  if not SUCCEEDED(SHGetFolderPath(0, CSIDL_Fonts, 0, SHGFP_TYPE_CURRENT,

    @FontDir[0])) then

    raise Exception.Create('Can not find system Font directory');



  LocalFontPath := IncludeTrailingBackslash(LocalFontPath);



  Reg := TRegistry.Create(KEY_ALL_ACCESS);

  try

    for Font in TDirectory.GetFiles(LocalFontPath, '*.*',

      TSearchoption.soTopDirectoryOnly) do

    begin

      if SysUtils.FileExists(FontDir + SysUtils.ExtractFileName(Font)) then

        raise Exception.CreateFmt('%s is exists in system font directory',

          [SysUtils.ExtractFileName(Font)]);



      TFile.Copy(Font, FontDir + SysUtils.ExtractFileName(Font));

      Reg.RootKey := HKEY_LOCAL_MACHINE;

      Reg.LazyWrite := False;

      Reg.OpenKey('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts', False);

      Reg.WriteString(SysUtils.ExtractFileName(Font) + ' (TrueType)',

        SysUtils.ExtractFileName(Font));

      Reg.CloseKey;

      AddFontResource(PChar(FontDir + SysUtils.ExtractFileName(Font)));

    end;

  finally

    Reg.Free;

  end;

  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

end;

برای استفاده از کد ، کتابخانه های IOUtils و Types رو به برنامه اضافه کنید .

اگر مشکل داشت بگید تا بررسیش کنم .

در ضمن ، اون کدی که در پست اول قرار دادی عملا Spaghetti Code هست !