Używam trzech fontów rejestrowanych dynamicznie z plików znajdujących się w podkatalogu programu. Do rejestracji fontów używam systemowej funkcji AddFontResource
, do ich usunięcia RemoveFontResource
, a po wprowadzonych zmianach rozsyłam komunikat WM_FONTCHANGE
, jak prawi dokumentacja. Niżej kod dwóch metod – jedna ładuje fonty, druga je zwalnia:
procedure TFontsManager.LoadFromFiles(const APath: String);
var
LFontKind: TFontKind;
LFileName: String;
begin
FSource := fntsDiskFiles;
for LFontKind in TFontKind do
begin
LFileName := APath + FONT_FILE_NAMES[LFontKind];
FCounts[LFontKind] := AddFontResource(PChar(LFileName)); // <–
if (FCounts[LFontKind] = 0) and (Screen.Fonts.IndexOf(FONT_NAMES[LFontKind]) = -1) then
begin
UnloadFontFiles();
Exit;
end;
end;
FLoaded := True;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
procedure TFontsManager.UnloadFontFiles();
var
LFontKind: TFontKind;
begin
for LFontKind in TFontKind do
if FCounts[LFontKind] <> 0 then
begin
RemoveFontResource(PChar(FONT_FILE_NAMES[LFontKind])); // <–
FCounts[LFontKind] := 0;
end;
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
Interesujące mnie linijki opatrzyłem komentarzami.
Pod WinXP wszystko działa super, jednak problem stanowią nowsze systemy – np. Win7 – fonty nie są prawidłowo zwalniane. Odkryłem to przez przypadek, kiedy testowałem w tym systemie wersję przenośną (z pendrive'a). Uruchomiłem program, pobawiłem się i go wyłączyłem. Na koniec skorzystałem z systemowego narzędzia do bezpiecznego usuwania sprzętu – nie dało się odłączyć urządzenia, dlatego że wszystkie trzy pliki fontów były wciąż używane przez system.
Uznałem, że użycie funkcji AddFontResource
i RemoveFontResource
to zły pomysł i powinienem użyć wersji z sufiksem Ex
. Moduł Windows
nie zawiera nagłówków, więc zdefiniowałem je w ten sposób:
function AddFontResourceEx(lpszFilename: LPCSTR; fl: DWORD; pdv: PVOID): LongInt; external 'gdi32' name 'AddFontResourceExA';
function RemoveFontResourceEx(lpszFilename: LPCSTR; fl: DWORD; pdv: PVOID): LongInt; external 'gdi32' name 'RemoveFontResourceExA';
Do kompletu jeszcze dochodzi jedna stała, która również nie istnieje w bibliotece Lazarusa:
const
FR_PRIVATE = $10;
Zmieniłem więc linijki zawierające wywołania systemowych funkcji na takie:
FCounts[LFontKind] := AddFontResourceEx(PChar(LFileName), FR_PRIVATE, nil);
// i
RemoveFontResourceEx(PChar(FONT_FILE_NAMES[LFontKind]), FR_PRIVATE, nil);
Teraz fonty w ogóle nie są ładowane – AddFontResourceEx
trzy razy zwraca 0
, a na końcu metody leci SIGSEGV
– z d**y, kiedy wykonanie kodu tej metody dochodzi do ostatniego end
. ;)
Moje pytanie brzmi: w jaki sposób poprawnie ładować fonty z plików dostarczanych wraz z aplikacją (bez trwałej instalacji w systemie) i w jaki sposób je poprawnie z systemu usuwać?