True Type Font Iconography for Windows

  

These is no problem on Mac OS X, Android , iOS.

But on Windows, just like Windows 7 and Windows 10. I have some trouble
Code:

{$IFDEF MSWINDOWS}
System.Win.Registry,
Winapi.Windows,
Winapi.Messages,
{$ENDIF}

function AddFont(FontName: string): Boolean;
const
REG_FONT_KEY = ‘SOFTWAREMicrosoftWindows NTCurrentVersionFonts’;
var
arr: array [0 .. MAX_PATH] of Char;
WinFontDir, WinFontFileName, SoureFontDir, SourceFontFilename, FotFileName: string;
Reg: TRegistry;
begin
//Create FontSource
GetWindowsDirectory(arr, MAX_PATH);
WinFontDir := arr;
WinFontDir := WinFontDir + PathDelim + ‘Fonts’;
WinFontFileName := WinFontDir + IconFontname + ‘.ttf’;

SoureFontDir := ExtractFileDir(GetModuleName(HInstance));
SourceFontFilename := SoureFontDir + PathDelim + IconFontname + ‘.ttf’;

FotFileName := ExtractFileDir(GetModuleName(HInstance)) + PathDelim + IconFontname + ‘.fot’;

Result := CopyFile(PWideChar(SourceFontFilename), PWideChar(WinFontFileName), False);

Result := Result and CreateScalableFontResource(0, PWideChar(FotFileName), PWideChar(IconFontname + ‘.ttf’), PWideChar(SoureFontDir));

Result := Result and (AddFontResource(PWideChar(WinFontFileName)) <> 0);

Reg := TRegistry.Create(KEY_READ);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if (not Reg.KeyExists(REG_FONT_KEY)) then begin
Exit;
end;
Reg.Access := KEY_WRITE;
if not Reg.OpenKey(REG_FONT_KEY, True) then begin
Exit;
end;
Reg.WriteString(IconFontname, IconFontname + ‘.ttf’);
Reg.CloseKey();
finally
Reg.Free;
end;
//SendMessage

SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

it works on windows7 for classic theme.

but on Windows 7, it doesn’t work for Aero theme or Windows 7 basic theme.

So, how can I use My True Type Font perfectly for every theme.

Can you help me?

Thanks!

Comments are closed.