usage of AddFontResourceEx and CreateFont
lazarus / 34-Windows

----------------------------------------------------------------------
KemBill · 2017-11-30 13:42

Hello,

I wish to use a custom font in my app (not installed on the system,
just in my app directory). So I need to temporarily register the font
with AddFontResourceEx, but I cant figure how to make CreateFont work
with, in order to output text for example on a bitmap.

CreateFont needs a font name, not necessarily the same than the font
file name...  I need explanations 

many thanks !

----------------------------------------------------------------------
RAW · 2017-11-30 14:52

I don't see why you need CreateFont.
Take a look at this thread...
http://forum.lazarus.freepascal.org/index.php/topic,21032.30.html
Embed a font without installing...

// something like this should be enough...
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Function
AddFont    (Dir : PAnsiChar;                      Flag: DWORD):
LongBool; StdCall;                      External GDI32               
     Name 'AddFontResourceExA';  Function RemoveFont (Dir :
PAnsiChar;                      Flag: DWORD): LongBool; StdCall;     
               External GDI32                      Name
'RemoveFontResourceExA';Implementation {$IFNDEF FPC}  {$R
*.DFM} {$ELSE}  {$R *.LFM} {$ENDIF}  Procedure
TForm1.FormCreate(Sender: TObject);  Var   strAppPath: String; Begin 
strAppPath:= ExtractFilePath(Application.ExeName);   If
FileExists(strAppPath+'FONTS\MONT BLACK.otf')  Then   If
AddFont(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'), $10)   Then
SendMessage(Handle, WM_FONTCHANGE, 0, 0); End;  Procedure
TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction); 
Var   strAppPath: String; Begin  strAppPath:=
ExtractFilePath(Application.ExeName);   If
FileExists(strAppPath+'FONTS\MONT BLACK.otf')  Then   If
RemoveFont(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'), $10)   Then
SendMessage(Handle, WM_FONTCHANGE, 0, 0); End;  Procedure
TForm1.FormClick(Sender: TObject); Begin  Label1.Font.Name:=
'Montserrat Black';  Label1.Font.Size:= 50; End; END.

----------------------------------------------------------------------
KemBill · 2017-11-30 15:33

thank you for your reply, in fact i'm upgrading a program that use
windows API.

I need to convert the loaded font into a windows HFONT, in short, in
your example how do you convert "FONTS\MONT BLACK.otf" into
"Montserrat Black" programmatically (if possible without freetype) ?

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var  dc:
hdc;  bm: BITMAPINFO;  bmp: HBITMAP;   FontHandle : HFONT;begin[...] 
FontHandle := CreateFont(Quality, 0, 0, 0, FW_NORMAL, FALSE, FALSE,
FALSE, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
ANTIALIASED_QUALITY, DEFAULT_PITCH, pchar(name));  SelectObject(dc,
bmp);  SelectObject(dc, FontHandle);  SetBkColor(dc, RGB(0, 0, 0)); 
SetTextColor(dc, RGB(255, 255, 255)); [...]end;

----------------------------------------------------------------------
RAW · 2017-11-30 15:57

This works for me...
// I know this is not API only but CreateFont works nice... 
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i Procedure
TForm1.Button1Click(Sender: TObject);  Var   hFt:HFont; Begin  hFt:=
CreateFont   (90, 20, 900, 0, FW_DONTCARE, 1, 1, 0,    ANSI_CHARSET,
OUT_OUTLINE_PRECIS,    CLIP_TT_ALWAYS, DEFAULT_CHARSET,
ANTIALIASED_QUALITY    And FF_DECORATIVE, 'Lucida Console');    Try  
Label1.Font.Handle:= hFt;    Label1.Caption    := 'MyFont Is
Nice...';   Finally    DeleteObject(hFt);   End; End;

----------------------------------------------------------------------
KemBill · 2017-11-30 16:23

Yes, i'm almost sure that windows API works 

you call createfont with a "display name" or something like that. on
your hard drive the ttf file name does not match with that display
name.
you can also rename the ttf file, the "display name" will remain the
same...

I found so far the undocumented API GetFontResourceInfo
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD;
lpBuffer: PChar; dwQueryType: DWORD): DWORD; stdcall; external
'gdi32.dll' name 'GetFontResourceInfoW';

----------------------------------------------------------------------
RAW · 2017-11-30 17:14

@KemBill
Are you sure you need anything special to do??? For me it works out of
the box (API ONLY).
Give me some seconds to format the test program, otherwise nobody can
read the source code...

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
WM_PAINT: Begin  DC:= GetDC(hWndPopup);   hFt:= CreateFont   (0, 0,
500, 0, FW_DONTCARE, 0, 0, 0,    ANSI_CHARSET, OUT_OUTLINE_PRECIS,   
CLIP_TT_ALWAYS, DEFAULT_CHARSET, ANTIALIASED_QUALITY    And
FF_DECORATIVE, 'Montserrat Black');   SelectObject(DC, hFt); 
TextOut(DC, 50, 50, PChar('HELLO'), Length('HELLO'));  
DeleteObject(hFt);  ReleaseDC(hWndPopup, DC); End;

----------------------------------------------------------------------
KemBill · 2017-11-30 17:36

Please look:

first you call loadFont with 'MONT BLACK.otf' as the file name
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
AddFont(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf')
second, you call Createfont with 'Montserrat Black' as the font face
name (lpszFace on msdn)
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i CreateFont
([...] 'Montserrat Black');
my question is simply:
How can I obtain the font face name from an unknown file, in this case
'Montserrat Black' from 'MONT BLACK.otf' ?

----------------------------------------------------------------------
RAW · 2017-11-30 17:42

Aaaah, OK, Now I got it...
Interesting... never needed this before, maybe I can figure it out.
BTW: If you find a good solution then please tell me...

----------------------------------------------------------------------
KemBill · 2017-11-30 18:04

I found a delphi snipet that I adapted to FPC, the only snipet that
seems to work for me (source:
https://stackoverflow.com/questions/13381537/how-do-i-get-the-font-
name-from-a-font-file)

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i function
GetFontNameFromFile(FontFile: WideString): string;type 
TGetFontResourceInfoW = function(Name: PWideChar; var BufSize:
Cardinal;    Buffer: Pointer; InfoType: Cardinal): LongBool;
stdcall;var  GFRI: TGetFontResourceInfoW;  AddFontRes, I: Integer; 
LogFont: array of TLogFontW;  lfsz: Cardinal;  hFnt: HFONT;begin  GFRI
:= TGetFontResourceInfoW(GetProcAddress(GetModuleHandle('gdi32.dll'),
'GetFontResourceInfoW'));  if @GFRI = nil then    raise
Exception.Create('GetFontResourceInfoW in gdi32.dll not found.');   if
LowerCase(ExtractFileExt(FontFile)) = '.pfm' then    FontFile :=
FontFile + '|' + ChangeFileExt(FontFile, '.pfb');   AddFontRes :=
AddFontResourceW(PWideChar(FontFile));  try    if AddFontRes > 0 then 
    begin        SetLength(LogFont, AddFontRes);        lfsz :=
AddFontRes * SizeOf(TLogFontW);        if not
GFRI(PWideChar(FontFile), lfsz, @LogFont[0], 2) then          raise
Exception.Create('GetFontResourceInfoW failed.');         AddFontRes
:= lfsz div SizeOf(TLogFont);        for I := 0 to AddFontRes - 1 do 
       begin            hFnt := CreateFontIndirectW(LogFont[I]);     
     try              Result := LogFont[I].lfFaceName;           
finally              DeleteObject(hFnt);            end;          end;
// for I := 0 to AddFontRes - 1      end; // if AddFontRes > 0 
finally    RemoveFontResourceW(PWideChar(FontFile));  end;end;
but i don't really understand the usage of an array in the GFRI
function call 

edit: here is the doc of the undocumented function GetFontResourceInfo
http://www.undocprint.org/winspool/getfontresourceinfo

it seems to me, it's unicode (widechar) only