Добавление шрифта

[Ntlegend]

Доброго времени суток, уважаемые знатоки.
У меня возникла такая проблема, если запускать приложение на другом компе где не установлен нужный шрифт - приложение не хочет работать, как выход сделал следующее:
1) при старте делаю проверку наличия шрифта
2) если шрифта нету - то устанавливаю его

но все же приложение выбивает с ошибкой об неустановлденом шрифте.. все последующие запуски (без перезагрузки компа) происходят нормальо..
Как можна решить данную кроме как после установки шрифта запускать свою копию и тихонько закрывать приложение??

пишу на API с использованием GDI+.
проверку и установку делаю так:

//установка шрифта, файл шрифта лежит в ресурсах программы
function InstallFont:boolean;
var FindHandle, ResHandle: THandle;
    ResPtr: Pointer;
    siz, f, br:cardinal;
    pch:PChar;
    phkResult:HKEY;
begin
Result:=false;
FindHandle:=FindResource(HInstance, 'MTCORSVA', 'TTF');
if FindHandle<>0
 then begin
  siz:=SizeofResource(HInstance, FindHandle);
  ResHandle:=LoadResource(HInstance, FindHandle);
  if ResHandle<>0
   then begin
    ResPtr:=LockResource(ResHandle);
    if ResPtr<>nil
     then begin
      pch:='C:\WINDOWS\Fonts\MTCORSVA.TTF';
      f:=CreateFile(pch, GENERIC_WRITE, FILE_SHARE_WRITE, nil, 2, FILE_ATTRIBUTE_NORMAL, 0);
      WriteFile(f, ResPtr^, siz, br, nil);
      CloseHandle(f);
      if RegCreateKeyEx(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts', 0, nil,
                        REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, phkResult, nil)=ERROR_SUCCESS
       then begin
        pch:='MTCORSVA.TTF';
        RegSetValueEx(phkResult, 'Monotype Corsiva', 0, REG_SZ, pch, Length(pch)+1);
        RegCloseKey(phkResult);
        pch:='C:\WINDOWS\Fonts\MTCORSVA.TTF';
        AddFontResource(pch);
        SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
        Sleep(1000);
        Result:=true;
       end;
     end;
   end;
  FreeResource(FindHandle);
 end;
end;

var FF : GpFontFamily;
begin
  if GdipCreateFontFamilyFromName('Monotype Corsiva', NIL, FF)<>Ok
   then begin
    if not LoadFont
     then ExitProcess(0);
   end;
  GdipDeleteFontFamily(FF);
//дальше код программы
end;

буду благодарен за любые интересные ответы.

[mihali4]

Добавить фонт (.fon, .fot, .fnt, .ttf) в систему можно след. образом:
{$IFDEF WIN32}
AddFontResource(PChar(my_font_PathN ame{AnsiString}));
{$ELSE}
var
ss: array [ 0..255 ] of Char;

AddFontResource(StrPCopy(ss, my_font_PathName));
{$ENDIF}
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Убрать его по окончании работы:
{$IFDEF WIN32}
RemoveFontResource(PChar(my_font_Pa thName));
{$ELSE}
RemoveFontResource(StrPCopy(ss, my_font_PathName));
{$ENDIF}
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

Где my_font_PathName - полный путь к файлу со шрифтом.

[DomiNick]

Сам пока не пробовал, но вот есть интересная статья...

[Ntlegend]

mihali4, я работаю тока под 32-х разрядной ВинХР, поэтому проверка
{$IFDEF WIN32} тут лишняя.. и если ты смотрел код то у меня есть сообщения
AddFontResource
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

DomiNick, спасиба за статью, описаный там метод работать не будет.. чирбы гарантировано установить шрифт в систему - нада прописать его в реестре (см. мой код). и еще отличие моего метода и того что в даной - разные способы извлечения ресурса, и в статья не приведена проверка на его наличие.