Использование своего шрифта под Windows

[ruslan]

Подскажите, знает ли кто как в FMX использовать свой шрифт не устанавливая его в в систему ?

под vcl было что-то вроде:

procedure LoadFont;
  var
    MyResStream: TResourceStream;
  begin
    MyResStream:= GetResStream('MyFont');
    MyResStream.SavetoFile('MyFont.ttf');
    AddFontResource(PChar('MyFont.ttf'));
    SendMessage(HWND_BROADCAST, WM_FONTCHANGE,0,0);
  end;

  procedure UnLoadFont;
  begin
    RemoveFontResource('MyFont.ttf') ;
    SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
  end;

в фаирманках, что удивительно(сарказм),  этот не работает. 

как я понимаю, шрифты подгружаются в момент запуска приложения, и рисуются средствами gdi...

 

хотел поправить юнит FMX.FontGlyphs.Win по аналогии с http://delphifmandroid.blogspot.com/2015/01/true-type.html

но TWinFontGlyphManager даже не создается( дебагер не попадает в конструктор ).

 

вопрос: как решить эту маленькую проблему ?

 

 

[AngryOwl]

Уважаемые гуру! Вопрос больше к вам. Так как в VCL Windows-приложении использовать свой шрифт - проблем нет. А как быть с нашей замечательной FMX ?

 

Успользование своего шрифта в приложении. Варианты - либо временное, на время работы приложения, либо постоянное - установка приложением своего шрифта.

 

P.S. Варианты с Android и iOS не предлагать. Интересует только Windows.

[Вячеслав]

Все приемы для Vcl лично у меня ни к чему не привели. Вам проще всего будет bat-файл для установки шрифта в систему написать, имхо.

[AngryOwl]

Друзья! Неужели никто еще не сталкивался с такой же проблемой?

Установка шрифта какими-то "экзотическими" методами (типа батников и "дополнительным софтом") - это, мягко говоря, некорректное решение.

Может кто-то подскажет программное решение?

А то Андрей Ефимов любезно подсказал как можно использовать шрифты на андроиде, а как быть в данном случе с виндой!?

[haword]

а подредактировать FMX.FontGlyphs.Win.pas и в нем изменить название шрифта при выполнении CreateFont пробовали? 

[sinuke]

эээх. очень жаль конечно, что на вин такого не сделать. уже сделал свой шрифт со всеми нужными иконками, но внедрение придётся отложить, т.к. на вин шрифт программно не установить (без костылей ввиде батников). а жаль, на андройде очень хорошо получается

выход нашел только один - инсталятор. не хотелось, но будет инсталятор

Изменено 3 сентября, 2016 пользователем sinuke

[AngryOwl]

В общем можно сделать, конечно, установку шрифта в инсталлере программы. И это будет оптимальным решением.

Но можно обойтись и без него.

Не буду расписывать детали, просто закину приложение и фрагменты кода. Думаю разберетесь. Естественно изменив на свои шрифты и т.п.

Все нижеперечисленное - в файл проекта DPR, перед Application.Initialize;

const
  CKey = '\Software\Microsoft\Windows NT\CurrentVersion\Fonts';
  CFontFileName = 'spherelive.ttf';
  CFontName = 'spherelive (TrueType)';

procedure ExecuteWait(const sProgramm: string; const sParams: string = ''; fHide: Boolean = false);
var
  ShExecInfo: TShellExecuteInfo;
begin
  FillChar(ShExecInfo, sizeof(ShExecInfo), 0);
  with ShExecInfo do
  begin
    cbSize := sizeof(ShExecInfo);
    fMask := SEE_MASK_NOCLOSEPROCESS;
    lpFile := PChar(sProgramm);
    lpParameters := PChar(sParams);
    lpVerb := 'open';
    if (not fHide) then
      nShow := SW_SHOW
      else
      nShow := SW_HIDE
  end;
  try
    if (ShellExecuteEx(@ShExecInfo) and (ShExecInfo.hProcess <> 0)) then
    try
      WaitForSingleObject(ShExecInfo.hProcess, INFINITE)
    finally
      CloseHandle(ShExecInfo.hProcess);
    end;
  except
    On E : Exception do
      ShowMessage('font install Exception: ' + E.Message);
  end;
end;

  if not IsFontRegistered(TPath.Combine(ExtractFilePath(ParamStr(0)), CFontFileName), CFontName) then
    if FileExists(TPath.Combine(ExtractFilePath(ParamStr(0)), 'RegFontC.exe')) then
      ExecuteWait(TPath.Combine(ExtractFilePath(ParamStr(0)), 'RegFontC.exe'));

  Application.Initialize;

Где будет лежать файл со шрифтом - это уже ваше дело. Можно его куда угодно поместить. Хоть в ресурсы, хоть файлом просто, хоть с инета скачать.

P.S. Ну и конечно - это все именно под винду...

RegFont.zip

[dnekrasov]

В Berlin и Tokyo AddFontResource и RemoveFontResource прекрасно отрабатывают, только вызывать их надо до Application.Run.

Кстати, лучше использовать  AddFontResourceEx и RemoveFontResourceEx с флагом FR_NOT_ENUM - тогда надобность в SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) отпадает.

[vasilius]

В 01.05.2017 в 11:15, dnekrasov сказал:

В Berlin и Tokyo AddFontResource и RemoveFontResource прекрасно отрабатывают, только вызывать их надо до Application.Run.

Кстати, лучше использовать  AddFontResourceEx и RemoveFontResourceEx с флагом FR_NOT_ENUM - тогда надобность в SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) отпадает.

Токио, Билдер... не работает

    AddFontResourceEx(L"4960.ttf", FR_PRIVATE , NULL);

    try {
        Application->Initialize();
        Application->CreateForm(__classid(TForm2), &Form2);
        Application->Run();
    }

проверка

 

  TStrings * FontList;
  HDC dContext;
  LOGFONT * LFont;

  dContext = GetDC(0);
  LFont = new LOGFONT();
  LFont->lfCharSet = DEFAULT_CHARSET;

  EnumFontFamiliesEx(dContext, LFont, (FONTENUMPROC)&EnumFontsList, LPARAM(Memo1->Lines), 0);
  ReleaseDC(0, dContext);
  Label55->TextSettings->Font->Family = "5x5 Dots";
 

в списке фонт появляется, но к контролам не применяется

если   делать через FR_NOT_ENUM, то в списке даже не появляется и тоже не работает

 

[dnekrasov]

В 23.08.2018 в 02:20, vasilius сказал:

AddFontResourceEx(L"4960.ttf", FR_PRIVATE , NULL);

FR_PRIVATE не работает - используйте FR_NOT_ENUM или 0.

FR_NOT_ENUM и предназначен для того, чтобы он не попадал в список перечисления.

В 23.08.2018 в 02:20, vasilius сказал:

Label55->TextSettings->Font->Family = "5x5 Dots";

А у Label55 из StyledSettings убрали Family?

[vasilius]

Вот скриншоты

В проекте перед всеми инитами делаю

#ifdef _WIN32
	int res = AddFontResourceEx(L"4960.ttf", FR_NOT_ENUM , NULL);
#endif

	try {
		Application->Initialize();
		Application->CreateForm(__classid(TForm2), &Form2);
		Application->Run();
	}
	catch (Exception &exception) {
		Application->ShowException(&exception);
	}
	catch (...) {
		try {
			throw Exception("");
		}
		catch (Exception &exception) {
			Application->ShowException(&exception);
		}
	}
	return 0;

на скриншоте показано, что res == 1 - тоесть ф-ция удачно выполнилась

дальше по нажатию на кнопку пытаюсь поменять шрифт

Label55->TextSettings->Font->Family = "5x5 Dots";

StyledSettings все выключены - показано на скрине - в результате ничего.... -(

[dnekrasov]

В 29.08.2018 в 00:38, vasilius сказал:

AddFontResourceEx(L"4960.ttf", FR_NOT_ENUM , NULL);

Попробуйте указать полный путь к шрифту, а не только его имя файла. 

[vasilius]

11 минут назад, dnekrasov сказал:

Попробуйте указать полный путь к шрифту, а не только его имя файла. 

скопировал шрифт в корень диска С

#ifdef _WIN32
	int res = AddFontResourceEx(L"C:\4960.ttf", FR_NOT_ENUM , NULL);
#endif

	try {
		Application->Initialize();
		Application->CreateForm(__classid(TForm2), &Form2);
		Application->Run();
	}
	catch (Exception &exception) {
		Application->ShowException(&exception);
	}
	catch (...) {
		try {
			throw Exception("");
		}
		catch (Exception &exception) {
			Application->ShowException(&exception);
		}
	}
	return 0;

все-равно не работает