• 0
ruslan

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

Вопрос

Подскажите, знает ли кто как в 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 даже не создается( дебагер не попадает в конструктор ).

 

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

 

 

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах

7 ответов на этот вопрос

  • 0

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

 

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

 

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

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

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

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

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

Изменено пользователем sinuke

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

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

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

Все нижеперечисленное - в файл проекта 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

Rusland, Евгений Корепов, sinuke и 4 другим понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах
  • 0

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

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

Евгений Корепов и eser понравилось это

Поделиться сообщением


Ссылка на сообщение
Поделиться на других сайтах

Создайте аккаунт или войдите для комментирования

Вы должны быть пользователем, чтобы оставить комментарий

Создать аккаунт

Зарегистрируйтесь для получения аккаунта. Это просто!


Зарегистрировать аккаунт

Войти

Уже зарегистрированы? Войдите здесь.


Войти сейчас

  • Похожие публикации

    • Автор: Вадим Смоленский
      Этот вопрос сложился из двух, которые я здесь уже задавал, но ответов не получил. Первый касался странного поведения TWebBrowser. Второй - ненужного мелькания в виде белого квадрата при вызове TPopup и TPopupMenu. Теперь оказалось, что эти проблемы связаны. Мне удалось их воспроизвести в маленьком демонстрационном проекте (Windows), который прилагаю в виде зипа и скриншота.

      Кнопка Hide/Show прячет и снова показывает TWebBrowser. Но если хоть один раз (когда TWebBrowser виден) вызвать TPopupMenu или TPopup, это перестает работать - TWebBrowser отказывается прятаться. Характерно еще то, что в момент вызова TPopupMenu или TPopup в левом верхнем углу формы на долю секунды появляется непрошенный белый квадрат, и на эту же долю секунды TWebBrowser пропадает.
      Если минимизировать форму в трей и снова открыть (при условии, что TWebBrowser при этом как бы не виден, т.е. после нечетного числа щелчков по кнопке), то функциональность восстанавливается. Иными словами, проблема в отрисовке. Своими силами справиться не смог. Буду признателен за дельный совет. Побороть белый квадрат тоже очень хотелось бы, с ним некрасиво.
      TWebBrowserProblem.zip
    • Автор: Вадим Смоленский
      Работаю в Berlin, делаю приложение под Windows. При каждом вызове метода Popup для TPopupMenu, а также при создании и выводе на экран компонента TPopup, в левом верхнем углу формы на долю секунды появляется белый прямоугольник 50х50 пикселей. Нельзя ли как-нибудь это явление подавить?

    • Автор: Pax Beach
      Мне нужно сделать снимок экрана из своего приложения в приложении DirectX (в игре).
      По-быстрому накидал приложение, исходники здесь: MakeScreenshot-Forum.zip

      1. по нажатию единственной кнопки будет выполнена серия из 16 снимков экрана. Если запущен Скайп, то фотографироваться будет содержимое его окна.
      2. По нажатии CTRL+ALT+F9 будет сделан единичный снимок
      3. Label внизу показывает сколько миллисекунд затрачено на вывод снимка
      4. В комментах так же вы найдете, как работать со снимками через буфер обмена.
       
      Работа выполняется через GetDC(NULL);
      Windows 10 x64. Снимки делаются. И DirectX тоже нормально фотографируется.
      НО! только в оконных приложениях.
      Если приложение DirectX полноэкранное, то на всех снимках одна и та же картинка с первого снимка.
      То есть изменение буфера экрана в приложении ни как не отражается на снимках.
       
      Что нужно? Необходимо делать снимки конкретного приложения через интерфейс DirectX, а точнее, я так понимаю, через DirectShow. Тогда не будет разницы в окне оно или на полный экран.
      Помогите плиз, знающие люди, с решением этой задачи.
      Гарантирую вам от сообщества большой почет, от меня огромный респект, если это принесет доход, то еще и очень приятный бонус.
       
      Ссылки теме:
      1. DIRECTX FOR DELPHI
      2. unofficial version of DelphiX
      3. DirectX для начинающих
      4. MinHook - The Minimalistic x86/x64 API Hooking Library
      5. Various methods for capturing the screen
      6. Вывод графики на рабочий стол Windows с использованием оверлеев DirectX
      7. Project JEDI
      8. Реализация перехвата вызовов API — исчерпывающе про внедрение DLL, если разобраться, + это на Delphi
      UPD:
      9. Серия видео уроков Пишем D3D-хук — все понятно, только в Delphi перенести нужно.
      UPD 2:
      Научился рисовать в Direct3D и ловить интерфейс IDirect3DDevice9. Теперь делаю DLL ловушку для реализации снимков.
       
    • Автор: chaplin.u@gmail.com
      Как определить язык системы в Win10 ?
    • Автор: Вадим Смоленский
      В Object Inspector подгружаю ImageList к TTabControl, иду в отдельные TTabItem, выбираю номера для ImageIndex. Иконки выводятся прижатыми к левому краю. Как выровнять их по центру? Текста не предусматриваю, будут только иконки.
    • Автор: Вадим Смоленский
      Если главное окно приложения для Windows выполнено как MDI и занимает почти весь экран, то пункты главного меню концентрируются слева, оставляя справа длинную пустую полосу. Этого пространства жалко, его можно было бы использовать с пользой - как, собственно, и сделано в интерфейсе RAD Studio: после пункта меню Help идет вертикальная полоска из точек, а дальше иконки, боксы поиска и прочее хозяйство. Как это можно сделать?
    • Автор: Евгений Корепов
      Господа и товарищи, помогите тупому мне! Столкнулся с странным. Под windows все отлично работает, а под android не могу добиться загрузки картинок. Мозг уже сломал.
      Собрал тестовый проект - в ListView (DynamicAppearance) добавляем 4 ListViewItem, в ListViewUpdatingObjects все создаем и грузим картинки из инета (потоки и прочее убрал для упрощения). Картанка слева, текст (URL) справа, проще некуда. Прилагаю к сообщению архив проекта и код.
      unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView, System.Net.HTTPClient, FMX.Objects; type TFormMain = class(TForm) ListView: TListView; procedure ListViewUpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } ListViewUpdate : Boolean; procedure MyListViewUpdateObjects(const AListView: TListView; const AItem: TListViewItem); procedure InitListView(AListView : TListView); function LoadImageFromURL(AURL : String) : TBitmap; end; var FormMain: TFormMain; implementation {$R *.fmx} procedure TFormMain.FormCreate(Sender: TObject); begin ListViewUpdate:=False; end; procedure TFormMain.FormShow(Sender: TObject); begin InitListView(ListView); end; procedure TFormMain.InitListView(AListView : TListView); Var AListViewItem : TListViewItem; AImageURL : String; begin AImageURL:='http://kayfolom.ru/images/test/'; ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + 'logo.png'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '000487806d3a2ab98aeb2c47b810fc8b.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '0012ef6cb42e95268a4cd1d832a2b93a.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); ListViewUpdate:=True; AListViewItem:=AListView.Items.Add; AListViewItem.Data['ImageURL']:=AImageURL + '0022454ccb4f81a701cb3a3c89d52d2f.jpg'; ListViewUpdate:=False; AListViewItem.Adapter.ResetView(AListViewItem); end; procedure TFormMain.ListViewUpdatingObjects(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean); begin if Not ListViewUpdate then begin MyListViewUpdateObjects(Sender as TListView, AItem); AHandled:=True; end; end; procedure TFormMain.MyListViewUpdateObjects(const AListView: TListView; const AItem: TListViewItem); Var AName : TListItemText; AImage : TListItemImage; AvailableWidth, ImageWidth, ImageHeight : single; function SetupTextObject(const AName, AText : String; AFontSize : Single; AFontStyles : TFontStyles; AWidth, AHeight, X , Y : Single; AAlign, AVertAlign: TListItemAlign; ATextAlign, ATextVertAlign: TTextAlign) : TListItemText; begin Result:=TListItemText(AItem.View.FindDrawable(AName)); if Result=Nil then Result:=TListItemText.Create(AItem); Result.Name:=AName; Result.Width:=AWidth; Result.WordWrap:=True; Result.Font.Size:=AFontSize; Result.Font.Style:=Result.Font.Style + AFontStyles; Result.Trimming:=TTextTrimming.None; Result.Text:=AText; Result.PlaceOffset.X:=X; Result.PlaceOffset.Y:=Y; Result.Align:=AAlign; Result.VertAlign:=AVertAlign; Result.TextAlign:=ATextAlign; Result.TextVertAlign:=ATextVertAlign; Result.Height:=AHeight; end; function SetupImageObject(const AName : String; AWidth, AHeight, X , Y : Single; AAlign, AVertAlign: TListItemAlign) : TListItemImage; Var AImageURL : String; begin Result:=TListItemImage(AItem.View.FindDrawable(AName)); if Result=Nil then begin Result:=TListItemImage.Create(AItem); AImageURL:=AItem.Data['ImageURL'].AsString; Result.Bitmap:=LoadImageFromURL(AImageURL); end; Result.Name:=AName; Result.Width:=AWidth; Result.Height:=AHeight; Result.PlaceOffset.X:=X; Result.PlaceOffset.Y:=Y; Result.Align:=AAlign; Result.VertAlign:=AVertAlign; Result.ScalingMode:=TImageScalingMode.StretchWithAspect; end; begin AvailableWidth:=AListView.Width - AListView.ItemSpaces.Left - AListView.ItemSpaces.Right; // Изображение размещаем слева ImageWidth:=AvailableWidth / 3; ImageHeight:=AvailableWidth / 3; AImage:=SetupImageObject('Image', ImageWidth, ImageHeight, 0, 0, TListItemAlign.Leading, TListItemAlign.Leading); // Текст справа AName:=SetupTextObject('Name', AItem.Data['ImageURL'].AsString, 14, [], AvailableWidth - ImageWidth, ImageHeight, ImageWidth, 0, TListItemAlign.Leading, TListItemAlign.Leading, TTextAlign.Center, TTextAlign.Center); AItem.Height:=Round(ImageHeight + AListView.ItemSpaces.Top + AListView.ItemSpaces.Bottom); end; function TFormMain.LoadImageFromURL(AURL : String) : TBitmap; Var AHTTPClient : THTTPClient; AStream : TMemoryStream; HTTPResponse : IHTTPResponse; begin Result:=Nil; AHTTPClient:=THTTPClient.Create; AStream:=TMemoryStream.Create; try HTTPResponse:=AHTTPClient.Get(AURL, AStream); finally if HTTPResponse.StatusCode=200 then Result:=TBitmap.CreateFromStream(AStream); end; end; end.  
      test092 ListView with Image.7z
    • Автор: Вадим Смоленский
      Использую TWebBrowser для вывода контекстной справки в специальном окне. При этом размеры TWebBrowser и его расположение на окне могут меняться в зависимости от режима. Наблюдается следующая странность: размеры и координаты TWebBrowser при первом выводе где-то запоминаются, и при смене режима, наряду с исправно отрисованным на новом месте TWebBrowser, на старом месте красуется белый прямоугольник, закрывающий все прочие контролы.
      Я уже прочитал в других вопросах форума, что TWebBrowser, будучи нативным компонентом, рисуется поверх других. Это бы ладно. Но когда поверх других рисуется мертвый белый фантом - это уже как-то чересчур. Есть ли способ это явление забороть?
    • Автор: Вадим Смоленский
      Клавиша пробела в Windows по умолчанию работает как акселератор кнопки, на которой фокус. Я в своем проекте использую пробел для других целей, и эту фичу мне нужно подавить. В VCL я перехватывал нажатие пробела в обработчике события TForm.OnKeyDown - устанавливал там флаг, который потом блокировал запуск содержимого TButton.OnClick. В FireMonkey, однако, TButton.OnClick запускается по нажатию пробела, не дожидаясь TForm.OnKeyDown. Как теперь быть?
    • Автор: Вадим Смоленский
      У TBitmap есть метод ReplaceOpaqueColor, заменяющий все непрозрачные цвета на один новый, передаваемый параметром. Не могу до конца понять, как он определяет на изображении прозрачный цвет, который должен остаться прозрачным. У меня на форме хранится большой невидимый TImage с черно-белым битмэпом, из которого я беру отдельные фрагменты посредством DrawBitmap и вывожу их на маленькие TImage. Иногда мне нужно организовать цветовое выделение - то есть, например, заменить черный цвет на синий, а белый оставить белым. В этом случае как раз и помогает ReplaceOpaqueColor(claBlue): почему-то белый цвет в монохромном битмэпе он трактует как прозрачный, не меняя его. Но вот парадокс: если я предварительно заменю в исходном большом битмэпе все белые пиксели на $00000000 (то есть, как я понимаю, nil, полностью прозрачный цвет), то ReplaceOpaqueColor ведет себя противоположным образом: он меняет этот прозрачный на синий, а черный не трогает! Очень бы хотелось понять, отчего так происходит и как с этим можно бороться.
      И шире: не ломлюсь ли я в открытую дверь? Может, в FMX есть какие-то более простые и мощные способы динамично преобразовывать цвета на TImage, просто я их не обнаружил?
  • Сейчас на странице   0 пользователей

    Нет пользователей, просматривающих эту страницу