Mój program podczas rozruchu dynamicznie instaluje fonty jako zasoby dla własnego użytku. Z racji tej, że program jest przenośny, wszystkie wymagane fonty posiada w swoich podkatalogach. Instalowane one są za pomocą funkcji AddFontResourceW z modułu Windows, a informacje o nich dodawane są do mapy – te dane są używane podczas deinstalacji fontów za pomocą RemoveFontResourceW, przy zamykaniu programu. Po instalacji i deinstalacji fontów, wołany jest SendMessage z komunikatem WM_FONTCHANGE, tak jak dokumentacja wskazuje.
Kod instalujący i deinstalujący wygląda tak:
type
TFontsMap = class(specialize TFPGMap<WideString, LongInt>)
public
procedure LoadFromDirectory(const APath: String);
procedure Unload();
end;
{..}
procedure TFontsMap.LoadFromDirectory(const APath: String);
var
FoundItem: TSearchRec;
var
FontName: WideString;
FontsCount: LongInt;
begin
if FindFirst(APath + '*.?tf', faAnyFile, FoundItem) = 0 then
try
repeat
FontName := UTF8ToUTF16(APath + FoundItem.Name);
FontsCount := Windows.AddFontResourceW(PWideChar(FontName));
Add(FontName, FontsCount);
until FindNext(FoundItem) <> 0;
finally
FindClose(FoundItem);
end;
if FindFirst(APath + '*', faAnyFile, FoundItem) = 0 then
try
repeat
if (FoundItem.Name = '.') or (FoundItem.Name = '..') then Continue;
if FoundItem.Attr and faDirectory = faDirectory then
LoadFromDirectory(APath + FoundItem.Name + '\');
until FindNext(FoundItem) <> 0;
finally
FindClose(FoundItem);
end;
end;
procedure TFontsMap.Unload();
var
FontIndex: Integer;
FontName: WideString;
begin
for FontIndex := 0 to Count - 1 do
if Data[FontIndex] <> 0 then
begin
FontName := Keys[FontIndex];
Windows.RemoveFontResourceW(PWideChar(FontName));
end;
end;
Powyższe metody wołane są z głównego obiektu zarządzającego, a po nich SendMessage:
type
TFonts = class(TObject)
private
FFonts: TFontsMap;
{..}
public
procedure LoadFromFiles(const APath: String);
procedure UnloadFiles();
end;
{..}
procedure TFonts.LoadFromFiles(const APath: String);
begin
FFonts.LoadFromDirectory(APath);
Windows.SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
procedure TFonts.UnloadFiles();
begin
FFonts.Unload();
Windows.SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
Problem polega na tym, że fonty zawsze instalują się i deinstalują prawidłowo, ale czasem podczas instalacji program zatrzymuje się na SendMessage i tak wisi w nieskończoność. Okazuje się, że program zawiesza się tylko wtedy, gdy uruchomiony jest Inkscape, GIMP lub Photoshop – gdy są wyłączone to wstaje za każdym razem, bez zająknięcia.
Ma ktoś pojęcie dlaczego tak się dzieje? :/
Sam nie rozumiem co mają ww. programy graficzne do tego, ale sprawdziłem dokładnie i ten błąd zreprodukowałem nawet pod WinXP (u klienta ten błąd występował pod Win10). Linijka po linijce pod debuggerem sprawdziłem i instalacja fontów przebiega bez problemu, a jak dochodzę do SendMessage to wykonanie tej linijki trwa w nieskończoność.