Delphi XE2实现永久性安装字体

无论是安装一些系统字体还是自定义的字体文件,本方法都是适用的。需要注意的是目前网络上介绍的使用AddFontResource实现安装字体,但是仅仅对本次设置有效,重启之后字体还是会消失。使用本文方法可永久实现字体的安装。

看看MSDN中关于安装字体的介绍:

To install unique hidden font resources follow these steps:
1 Copy the TrueType font file to a temporary file with a unique filename such as "ttfont01.ttf" that can be owned by the instance of the application. 
2、 Call the CreateScalableFontResource() function to create a uniquely named temporary hidden font resource file that can also be owned by the instance of the application. 
3、Call the AddFontResource() function to install this uniquely named font resource file for this instance of the application. 
4、Use the font in the application as desired.
5 When the instance of the application terminates or is otherwise finished with the font file, it should uninstall the font resource by calling the RemoveFontResource() function until it fails. 
6 Lastly, the instance of the application should delete the temporary font resource file and the temporary TrueType font file that it created. 

根据介绍,使用Delphi来实现:

procedure TForm11.Button12Click(Sender: TObject);
var
  sysDir, sFontFileName, sFontName, sFontDir, sFOTFile: string;
  ssourceDir: string;
  reg: TRegistry;
begin
  sFontFileName := 'msyh.ttf';//测试字体(微软雅黑)
  sysDir := GetWinDir;
  sFontDir := sysDir + '\Fonts\';
  sFOTFile := sFontDir + ChangeFileExt(sFontFileName, '.FOT');
  ssourceDir := ExtractFilePath(ParamStr(0)) + sFontFileName;
  //将字体文件复制到系统Fonts目录下
  CopyFile(PChar(ssourceDir), PChar(sFontDir+ sfontfileName), false);
  //创建字体资源文件
  CreateScalableFontResource(0, PChar(sFOTFile), PChar(sFontFileName), PChar(sFontDir));
  //添加字体资源
  AddFontResource(PChar(sFOTFile));
  //新增注册表项
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  try
    if reg.OpenKey('\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts', false) then
    begin
      if not reg.ValueExists('微软雅黑 (TrueType)') then
        reg.WriteString('微软雅黑(TrueType)', sFontFileName);
    end;
  finally
    reg.Free;
  end;
  //通知系统更新字体列表
  PostMessage(HWND_BROADCAST,  WM_FONTCHANGE,  0,  0);
end;
 

你可能感兴趣的:(Delphi)