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

[phomm]

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

Нашёл такой способ - создать через AddFontMemResourceEx шрифт в виде Hfont (но данный способ везде почему-то для чтения из ресурсов), и впоследствии устанавливать шрифт хендлом (Hfont), мне тоже не очень подходит, хочу оперировать Tfont'ом.

Нашёл хитрую функцию (хитрую потому, что на всех сайтах одна и та же копипаста с ошибкой, ну хоть исправить несложно) MakeFontFromHFont.

Но подружить всё вместе вот так не могу

function MakeFontFromHFont(aHandle: HFONT): TFONT;
var
  LogFont: TLogFont;
begin
  Result := TFont.Create;
  FillChar(LogFont, SizeOf(LogFont), 0);
  GetObject(aHandle, SizeOf(logfont), @LogFont);
  with LogFont, Result do
  begin
    Name   := StrPas(lffaceName);
    Height := -lfHeight;
    if lfWeight = FW_MEDIUM then
      Style := Style + [fsBold];
    if lfItalic <> 0 then
      Style := Style + [fsItalic];
    if lfUnderline <> 0 then
      Style := Style + [fsUnderline];
    if lfStrikeout <> 0 then
      Style := Style + [fsStrikeout];
    case (lfPitchAndFamily and 3) of
      VARIABLE_PITCH: Pitch := fpVariable;
      FIXED_PITCH: Pitch    := fpFixed;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  ms: TMemoryStream;
  i: DWord;
begin
  ms := TMemoryStream.Create;
  try
    ms.LoadFromFile('drom.ttf');
    fHFont := AddFontMemResourceEx(ms.Memory, ms.Size, nil, @i);
    ffont.assign(MakeFontFromHFont(fhfont)); // добавлять sendmessage(broadcast, fontchanged...) пробовал
  finally
    freeandnil(ms);
  end;
end;

Тестовый полигон прикладываю. Направьте меня малость, вчера полночь сидел - не сладил, ведь даже i=1 после addfont

ADD после ffont.assign у шрифта не меняется name (а шрифт в архиве имеет нейм HeinrichText)

собственно, полагаю, причина в Getobject..
add2 мда...

er := GetObject(aHandle, SizeOf(logfont), @LogFont);
  if er = 0 then
      showmessage(SysErrorMessage(GetLastError));

говорит "усё сиделана успесна, насяльника"

Может кто свой какой способ подскажет, не обязательно в точности под задачу, попробую адаптировать.

[phomm]

Путем нехитрой проверки функции MakeFontFromHFont из инета, установил, что она не при чем:

Edit1.Font.Name := 'scripts';
MakeFontFromHFont(Edit1.Font.Handle, label1.font); // переписал на процедуру с приемом ссылки на Tfont

Лабель заимела шрифт от эдита.

Отсюда вывод, по каким-то непонятным причинам конструкция

ms.LoadFromFile('drom.ttf');
fHFont := AddFontMemResourceEx(ms.Memory, ms.Size, nil, @i); // пробовал и в буфер перегонять

не даёт валидной ссылки на Hfont, но какую-то ссылку она дает ведь... более того в i записыввается кол-во добавленых шрифтов, и getlasterror говорит об успехе.

справка: http://msdn.microsoft.com/en-us/libr...(v=vs.85).aspx
This function allows an application to get a font that is embedded in a document or a webpage. A font that is added by AddFontMemResourceEx is always private to the process that made the call and is not enumerable.

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

Возможно ли какое-либо решение, или мне уйти делать всё по другому ? а вроде способ кажется вполне логичным и даже лаконичным.

Кстати, если Александр (GunSmoker) будет проходить тут, то напомню как-то было такое дело http://forum.sources.ru/index.php?showtopic=307303&st=0 и можно сказать некоторый опыт имеется )


ОО ! вот что нашёл http://www.eggheadcafe.com/microsoft...esourceex.aspx и из него вышел на http://msdn.microsoft.com/en-us/libr...42(VS.85).aspx

что за жесть ? почему возвращается непонятно какой хэндл ? зачем ещё createfont используя fontface если он мне как раз неизвестен, бредятина )) пошёл искать способы выдирания фонтфейса из ттф-файла

[phomm]

Тот пост длинный и от правок не разобрать... (mihali4, не злись)

В общем, накопал, вот http://forum.vingrad.ru/forum/topic-...1604536/0.html

Получилось загрузить шрифт и сохранить его в виде 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;

Вся остальная начинка - во вложении

[GunSmoker]

Не читал всё (длинно и лениво). Прошёлся по диагонали.

Но...

1. MakeFontFromHFont - господи, что это?

Font := TFont.Create;
Font.Handle := {твой HFont}

В твоём случае ещё проще:

Label.Font.Handle := {твой HFont};

2. GetObject - см. http://www.gunsmoker.ru/2011/02/6.html

[phomm]

1. мда, налицо легкий переинжиниринг, хотя этот вариант тоже пробовал, но из-за незнания точного устройства кухни виндовс, думал нужна и установка параметров из logfont, хотя потом по исходникам побегал, увидел только

procedure TFont.SetHandle(Value: HFont);
begin
  SetData(GetFontData(Value)); // которая практически идентична MakeFontFromHFont, с GetObject ессно
end;

Ну , тогда получился вариант для безВСЛ-ного окружения (точнее без модуля Graphics).
2. уже как-то читал, спасибо за наводку насчет подводного камня. Полагаю, в случае

Label.Font.Handle := {твой HFont};

также надо бы учесть сие дело, и в случае если мы имеем собственную функцию, то можно менять со стека на кучу, а как быть с всл-функцией ? обернуть в

{O+}Label.Font.Handle := {твой HFont};{O-}

? Или, поскольку SetData(GetFontData(Value)); где value это Hfont и заботиться не надо ? параметр 1 и он 4байтный...

Большое спасибо ) всегда рад наставлениям, развитие - бесконечный процесс.

И ещё если можно маленький эстетический вопрос - правильно ли использовать недокументированную GetFontResourceInfoW ? Хотя понимаю про "смотреть по задаче" и "учитывать совместимость с другими виндовс"?