Последние записи

made in programmersforum 10

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

23rd
Янв

Создать шрифт из файла и сохранить его в виде TFont

Posted by Chas under Delphi

Есть такой способ с помощью AddfontResource+Sendmessage(broadca st, fontchanged…), но он не позволяет сохранить себе шрифт (в Tfont) а можно лишь оперировать понятием fontface(оно же Tfont.name), мне это не подходит.

phomm
В общем, накопал. Получилось загрузить шрифт и сохранить его в виде Tfont (некий менеджер шрифтов как бы).

procedure MakeFontFromHFont(aHandle: HFONT; aTfont: TFONT);

//код
function GetFontName (FontFileA : PChar) : String;

//код
procedure TForm1.FormCreate(Sender: TObject);

const fntname = 'drom.ttf';

var

  ms: TMemoryStream;

  i: DWord;

  fhfont : THandle;

  fntface : string;

begin

  fFont := tfont.Create;

  ms := TMemoryStream.Create;

  try

    ms.LoadFromFile(fntname);

    fHFontMem := AddFontMemResourceEx(ms.Memory, ms.Size, nil, @i);

    fntface := GetFontName(fntname);

    fHFont := CreateFontA(24, 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET,

      OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,

      DEFAULT_PITCH, PAnsiChar(fntface));

    MakeFontFromHFont(fhfont, ffont);

  finally

    freeandnil(ms);

  end;

  Edit1.FONT := fFont; // we did it, thx to all

end;