Recent

Author Topic: usage of AddFontResourceEx and CreateFont  (Read 6850 times)

KemBill

  • Jr. Member
  • **
  • Posts: 74
usage of AddFontResourceEx and CreateFont
« on: November 30, 2017, 02:42:19 pm »
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

  • Hero Member
  • *****
  • Posts: 868
Re: usage of AddFontResourceEx and CreateFont
« Reply #1 on: November 30, 2017, 03:52:24 pm »
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][+][-]
  1. Function AddFont    (Dir : PAnsiChar;
  2.                       Flag: DWORD): LongBool; StdCall;
  3.                       External GDI32
  4.                       Name 'AddFontResourceExA';
  5.  
  6.  Function RemoveFont (Dir : PAnsiChar;
  7.                       Flag: DWORD): LongBool; StdCall;
  8.                       External GDI32
  9.                       Name 'RemoveFontResourceExA';
  10. Implementation
  11.  {$IFNDEF FPC}
  12.   {$R *.DFM}
  13.  {$ELSE}
  14.   {$R *.LFM}
  15.  {$ENDIF}
  16.  
  17.  
  18. Procedure TForm1.FormCreate(Sender: TObject);
  19.   Var
  20.    strAppPath: String;
  21.  Begin
  22.   strAppPath:= ExtractFilePath(Application.ExeName);
  23.  
  24.   If FileExists(strAppPath+'FONTS\MONT BLACK.otf')
  25.   Then
  26.    If AddFont(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'), $10)
  27.    Then SendMessage(Handle, WM_FONTCHANGE, 0, 0);
  28.  End;
  29.  
  30.  
  31. Procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  32.   Var
  33.    strAppPath: String;
  34.  Begin
  35.   strAppPath:= ExtractFilePath(Application.ExeName);
  36.  
  37.   If FileExists(strAppPath+'FONTS\MONT BLACK.otf')
  38.   Then
  39.    If RemoveFont(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'), $10)
  40.    Then SendMessage(Handle, WM_FONTCHANGE, 0, 0);
  41.  End;
  42.  
  43.  
  44. Procedure TForm1.FormClick(Sender: TObject);
  45.  Begin
  46.   Label1.Font.Name:= 'Montserrat Black';
  47.   Label1.Font.Size:= 50;
  48.  End;
  49.  
  50. END.
« Last Edit: November 30, 2017, 03:59:18 pm by RAW »
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

KemBill

  • Jr. Member
  • **
  • Posts: 74
Re: usage of AddFontResourceEx and CreateFont
« Reply #2 on: November 30, 2017, 04:33:31 pm »
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][+][-]
  1. var
  2.   dc: hdc;
  3.   bm: BITMAPINFO;
  4.   bmp: HBITMAP;
  5.   FontHandle : HFONT;
  6. begin
  7. [...]
  8.   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));
  9.   SelectObject(dc, bmp);
  10.   SelectObject(dc, FontHandle);
  11.   SetBkColor(dc, RGB(0, 0, 0));
  12.   SetTextColor(dc, RGB(255, 255, 255));
  13. [...]
  14. end;
  15.  
« Last Edit: November 30, 2017, 04:37:06 pm by KemBill »

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: usage of AddFontResourceEx and CreateFont
« Reply #3 on: November 30, 2017, 04:57:54 pm »
This works for me...
// I know this is not API only but CreateFont works nice...  :)
Code: Pascal  [Select][+][-]
  1. Procedure TForm1.Button1Click(Sender: TObject);
  2.   Var
  3.    hFt:HFont;
  4.  Begin
  5.   hFt:= CreateFont
  6.    (90, 20, 900, 0, FW_DONTCARE, 1, 1, 0,
  7.     ANSI_CHARSET, OUT_OUTLINE_PRECIS,
  8.     CLIP_TT_ALWAYS, DEFAULT_CHARSET, ANTIALIASED_QUALITY
  9.     And FF_DECORATIVE, 'Lucida Console');
  10.  
  11.    Try
  12.     Label1.Font.Handle:= hFt;
  13.     Label1.Caption    := 'MyFont Is Nice...';
  14.    Finally
  15.     DeleteObject(hFt);
  16.    End;
  17.  End;
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

KemBill

  • Jr. Member
  • **
  • Posts: 74
Re: usage of AddFontResourceEx and CreateFont
« Reply #4 on: November 30, 2017, 05:23:31 pm »
Yes, i'm almost sure that windows API works  :D

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][+][-]
  1. function GetFontResourceInfo(lpszFilename: PChar; var cbBuffer: DWORD; lpBuffer: PChar; dwQueryType: DWORD): DWORD; stdcall; external 'gdi32.dll' name 'GetFontResourceInfoW';
  2.  

 

RAW

  • Hero Member
  • *****
  • Posts: 868
Re: usage of AddFontResourceEx and CreateFont
« Reply #5 on: November 30, 2017, 06:14:20 pm »
@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][+][-]
  1. WM_PAINT:
  2.  Begin
  3.   DC:= GetDC(hWndPopup);
  4.  
  5.   hFt:= CreateFont
  6.    (0, 0, 500, 0, FW_DONTCARE, 0, 0, 0,
  7.     ANSI_CHARSET, OUT_OUTLINE_PRECIS,
  8.     CLIP_TT_ALWAYS, DEFAULT_CHARSET, ANTIALIASED_QUALITY
  9.     And FF_DECORATIVE, 'Montserrat Black');
  10.  
  11.   SelectObject(DC, hFt);
  12.   TextOut(DC, 50, 50, PChar('HELLO'), Length('HELLO'));
  13.  
  14.   DeleteObject(hFt);
  15.   ReleaseDC(hWndPopup, DC);
  16.  End;
« Last Edit: November 30, 2017, 06:27:03 pm by RAW »
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

KemBill

  • Jr. Member
  • **
  • Posts: 74
Re: usage of AddFontResourceEx and CreateFont
« Reply #6 on: November 30, 2017, 06:36:50 pm »
Please look:

first you call loadFont with 'MONT BLACK.otf' as the file name
Code: Pascal  [Select][+][-]
  1. 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][+][-]
  1. 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

  • Hero Member
  • *****
  • Posts: 868
Re: usage of AddFontResourceEx and CreateFont
« Reply #7 on: November 30, 2017, 06:42:43 pm »
 :D :D :D
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...  :)
Windows 7 Pro (x64 Sp1) & Windows XP Pro (x86 Sp3).

KemBill

  • Jr. Member
  • **
  • Posts: 74
Re: usage of AddFontResourceEx and CreateFont
« Reply #8 on: November 30, 2017, 07:04:53 pm »
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][+][-]
  1. function GetFontNameFromFile(FontFile: WideString): string;
  2. type
  3.   TGetFontResourceInfoW = function(Name: PWideChar; var BufSize: Cardinal;
  4.     Buffer: Pointer; InfoType: Cardinal): LongBool; stdcall;
  5. var
  6.   GFRI: TGetFontResourceInfoW;
  7.   AddFontRes, I: Integer;
  8.   LogFont: array of TLogFontW;
  9.   lfsz: Cardinal;
  10.   hFnt: HFONT;
  11. begin
  12.   GFRI := TGetFontResourceInfoW(GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW'));
  13.   if @GFRI = nil then
  14.     raise Exception.Create('GetFontResourceInfoW in gdi32.dll not found.');
  15.  
  16.   if LowerCase(ExtractFileExt(FontFile)) = '.pfm' then
  17.     FontFile := FontFile + '|' + ChangeFileExt(FontFile, '.pfb');
  18.  
  19.   AddFontRes := AddFontResourceW(PWideChar(FontFile));
  20.   try
  21.     if AddFontRes > 0 then
  22.       begin
  23.         SetLength(LogFont, AddFontRes);
  24.         lfsz := AddFontRes * SizeOf(TLogFontW);
  25.         if not GFRI(PWideChar(FontFile), lfsz, @LogFont[0], 2) then
  26.           raise Exception.Create('GetFontResourceInfoW failed.');
  27.  
  28.         AddFontRes := lfsz div SizeOf(TLogFont);
  29.         for I := 0 to AddFontRes - 1 do
  30.           begin
  31.             hFnt := CreateFontIndirectW(LogFont[I]);
  32.             try
  33.               Result := LogFont[I].lfFaceName;
  34.             finally
  35.               DeleteObject(hFnt);
  36.             end;
  37.           end; // for I := 0 to AddFontRes - 1
  38.       end; // if AddFontRes > 0
  39.   finally
  40.     RemoveFontResourceW(PWideChar(FontFile));
  41.   end;
  42. end;

but i don't really understand the usage of an array in the GFRI function call  :o

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
« Last Edit: November 30, 2017, 07:28:36 pm by KemBill »

 

TinyPortal © 2005-2018