Dynamiczne rejestrowanie własnych fontów – dobór odpowiednich funkcji

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ć?

a sprawdź co Ci zwraca RemoveFontResource. Może być tak, że RemoveFontResource nie może tego fontu zwolnić bo Twój program go używa.

Racja, RemoveFontResource zwraca False, również pod XP, więc tu jest haczyk.

Kod usuwający fonty z systemu wykonuje się po wywołaniu metody Application.Run (dokładniej, w sekcji finalization jednego z modułów wchodzących w skład pakietu komponentów), a w tym miejscu nie istnieją już żadne formularze czy komponenty. Dlatego też nie wiem co jest grane.

Edit: Cholera – przecież w metodzie UnloadFontFiles podaję samą nazwę pliku, beż ścieżki… :|

LFileName := APath + FONT_FILE_NAMES[LFontKind];
FCounts[LFontKind] := AddFontResource(PChar(LFileName));

Tak jak wyżej rejestrowałem swoje fonty, a tak jak niżej je zwalniałem:

RemoveFontResource(PChar(FONT_FILE_NAMES[LFontKind]));

Wystarczyło po pierwsze zapamiętać ścieżkę z argumentu w dodatkowym polu klasy (tu jako FFontsPath) i użyć tej ścieżki podczas usuwania fontów z systemu:

LFileName := FFontsPath + FONT_FILE_NAMES[LFontKind];
RemoveFontResource(PChar(LFileName));

Po tej zmianie funkcja prawidłowo zwraca True.

Gapiłem się na ten kod łącznie ze dwie godziny i nie zauważyłem tego. Dopiero po Twojej sugestii – @abrakadaber – czyli przyjrzenia się temu co zwraca funkcja, ujrzałem braki. Dzięki serdeczne.

się na przyszłość polecam :)