安装字体并使 Windows 知道

Question

我有一个下面的函数，它通过将字体 (.ttf) 复制到 Windows 字体文件夹然后触发 WM_FONTCHANGE 消息来将其安装到 Windows 中。但是，该字体不会立即在 Windows 资源管理器中可见。

在运行这之后，当我通过控制面板打开字体时，我的字体没有显示在那里。当我打开 C:\Windows\Fonts\ 时，它也没有显示在那里。

不过我可以确认我的 .ttf 文件确实存在。使用命令提示符导航到这里，我可以看到我的字体文件。当我打开 Character Map 实用程序时，我的字体列在此处。该字体可在我的应用程序中使用。我必须重新启动 explorer.exe 才能让它显示在 Windows 资源管理器视图中。我什至尝试运行我的应用程序作为管理员（提升），但仍然没有运气。

我认为 WM_FONTCHANGE 消息应该可以解决这个问题，但显然这没有用。

我在这个字体安装中遗漏了什么以确保 Windows 知道它？

uses
  SysUtils, ShlObj, ComObj, ActiveX;

function SystemDir(Handle: THandle; Folder: Integer): String;
var
  R: HRESULT;
  PIDL: PItemIDList;
  Path: array[0..MAX_PATH] of Char;
begin
  Result:= '';
  R:= SHGetSpecialFolderLocation(Handle, Folder, PIDL);
  if R = S_OK then begin
    if SHGetPathFromIDList(PIDL, Path) then
      Result:= StrPas(Path);
  end;
end;

function InstallFont(Handle: THandle; const Filename: String): Boolean;
var
  Dir, FN: String;
begin
  Result:= False;
  FN:= ExtractFileName(Filename);
  Dir:= IncludeTrailingPathDelimiter(SystemDir(Handle, CSIDL_FONTS));
  Result:= FileExists(Filename);
  if Result then begin
    Result:= CopyFile(PChar(Filename), PChar(Dir + FN), False);
  end;
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

用法：

Result:= InstallFont(Application.Handle, 'C:\MyTestFont.ttf');

更新

在下面的答案评论中建议通过 shell 而不是 Windows API 安装字体。所以，我写了这个函数来完成同样的事情：

function InstallFont2(Handle: THandle; const Filename: String): Boolean;
var
  R: HINST;
begin
  Result:= False;
  R:= ShellExecuteW(Handle, 'install', PWideChar(Filename), nil, nil, SW_HIDE);
  Result:= R > 32;
end;

然而这也是有问题的。 return 的值为 31 （表示错误），当我调用 GetLastError 时，它告诉我 1155 ("No application is associated with the specified file for this operation.")

我也尝试了下面答案中的特定分辨率，但无济于事。我都使用 AddFontResource 并编写了适当的注册表项 - 同时尝试 uninstalling/restarting/retrying 与此字体安装的组合。

Answer 1

WM_FONTCHANGE只是通知应用程序系统中有新字体，但实际上并没有告诉系统新字体是什么。

在发送WM_FONTCHANGE之前您需要调用AddFontResource将字体添加到系统字体table。如果您希望字体在重启后保留，您还需要在注册表项中添加一个条目 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts（请参阅 [=12 的文档=]了解更多信息）。

Answer 2

我刚刚详细了解了 Windows 7 安装字体时的具体操作。这是一个摘要：

如果字体是 true-type 字体并且它的名字还没有以 " (TrueType)" 结尾，那么它会附加这个。
如果字体已经存在，可以先卸载再安装：
- 它调用 RemoveFontResourceW。
- 描述字体的注册表项（如果有）已从 SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts 中删除。
它采用您要安装的文件名，如果该文件名已存在于 Fonts 目录中，则它会通过重复向计数器添加 1 然后格式化 "basename_X.ttf" 来扫描唯一的文件名，其中 X 是十六进制。所以例如如果 "myfont_1.ttf" 到 "myfont_9.ttf" 已经存在，那么它将尝试 "myfont_A.ttf" 接下来。
它将您提供的文件复制到它已识别的这个免费文件名中。
它在目标路径上调用 AddFontResourceW。
它根据“(TrueType)”限定的字体名称向 SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts 写入一个条目，其值为不带路径的目标文件名。
它做了一件我不太明白的事情，创建了一个 PropertyStore 并将一堆值放入其中。我不确定它对生成的属性存储到底做了什么，但它称它为 FID.
调用Sleep等待2秒。
它调用PostMessageW(HWND_BROADCAST, WM_SETTINGSCHANGE, NULL, L"fonts")
它调用PostMessageW(HWND_BROADCAST, WM_FONTCHANGE, NULL, NULL)
它调用 SHGetSpecialFolderLocation(CSIDL_FONTS)，然后将结果 IDLIST 传递给 SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_IDLIST, idlist, NULL)。

我怀疑后三种字体对于让系统识别其他应用程序和 Fonts 文件夹中的新字体至关重要。

安装字体并使 Windows 知道

Installing font and making Windows aware

windows

winapi

fonts