安装字体并使 Windows 感知

Question

I have a function below which installs a font ( .ttf ) into Windows by copying it into the Windows font folder and then triggering the WM_FONTCHANGE message. However, that font does not immediately become visible across Windows Explorer.

After running this, when I open Fonts through the Control Panel, my font does not show there. And when I open C:\\Windows\\Fonts\\ it does not show there either.

However I can confirm that my .ttf file is really there. Navigating here with the Command Prompt, I can see my font file. When I open the Character Map utility, my font is listed here. And the font is usable in my application. I have to restart explorer.exe to get it to show within the Windows Explorer views. I've even tried running my app as administrator (elevated), and still no luck.

I thought the WM_FONTCHANGE message was supposed to take care of this but apparently this is not doing the trick.

What am I missing in this Font Installation to make sure Windows is aware of it?

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;

Usage:

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

UPDATE

It was suggested in the comments of an answer below to install the font via the shell instead of Windows API. So, I wrote this function to essentially accomplish the same:

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;

However this too is problematic. The return value is 31 (indicating an error) and when I call GetLastError it tells me 1155 ("No application is associated with the specified file for this operation.")

I also tried the particular resolution in the answer below, but to no avail. I both used AddFontResource and written the appropriate registry key - while trying combinations of uninstalling/restarting/retrying with this font installation.

Answer 1

WM_FONTCHANGE only notifies applications of a new font in the system, but it doesn't actually tell the system what the new font is.

Before sending WM_FONTCHANGE you need to call AddFontResource to add the font to the system font table. If you want the font to remain after a reboot, you also need to add an entry to the registry key HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts (see the documentation for AddFontResource for more information).

Answer 2

I have just traced through exactly what Windows 7 does when it installs a font. Here is a summary:

• If the font is a true-type font and its name doesn't already end with " (TrueType)" then it appends this.
• If the font already exists, it can uninstall it in order to reinstall it:
  • It calls RemoveFontResourceW.
  • The registry entry describing the font, if any, is deleted out of SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts .
• It takes the filename you are trying to install, and if that already exists in the Fonts directory, then it scans for a unique filename by repeatedly adding 1 to a counter and then formatting "basename_X.ttf" where X is in hexadecimal. So eg if "myfont_1.ttf" through "myfont_9.ttf" already exist, then it will try "myfont_A.ttf" next.
• It copies the file you supplied to this free filename it has identified.
• It calls AddFontResourceW on the target path.
• It writes an entry to SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Fonts based on the "(TrueType)"-qualified name of your font whose value is the target filename without path.
• It does a thing I couldn't quite figure out, creating a PropertyStore and putting a bunch of values into it. I'm not sure what exactly it does with the resulting property store, but it calls it a FID .
• It waits for 2 seconds by calling Sleep .
• It calls PostMessageW(HWND_BROADCAST, WM_SETTINGSCHANGE, NULL, L"fonts")
• It calls PostMessageW(HWND_BROADCAST, WM_FONTCHANGE, NULL, NULL)
• It calls SHGetSpecialFolderLocation(CSIDL_FONTS) and then passes the resulting IDLIST into SHChangeNotify(SHCNE_UPDATEDIR, SHCNF_IDLIST, idlist, NULL) .

I suspect it is these latter three that are crucial in getting the system to recognize the new font in other applications and in the Fonts folder.