[SOLVED] Embed a font to use without installing
lazarus / 34-Windows

----------------------------------------------------------------------
fatmonk · 2013-05-29 16:16

According to http://www.lazarus.freepascal.org/index.php?topic=14276.0
this is easy to achieve in Windows, but a lot of searching has turned
up next to nothing.

What I'd like to do is include a specific font in my .exe for that
.exe to use. I don't want to install the font (the .exe is standalone
and doesn't need installing) and I don't want to save it onto the
users' machine.

So far the only hint I have is to include the font as a resource in
the project but I have no idea how to get the application to use that
font.

Can anyone give me any clues?

Thanks,

FM

----------------------------------------------------------------------
taazz · 2013-05-29 17:24

Code: [Select]const
    MM_MAX_NUMAXES = 16;
type
  PDesignVector = ^TDesignVector;
  TDesignVector = packed record
    dvReserved: DWORD;
    dvNumAxes: DWORD;
    dvValues: array[0..MM_MAX_NUMAXES-1] of Longint;
  end;

function AddFontMemResourceEx(p1: Pointer; p2: DWORD; p3:
PDesignVector; p4: LPDWORD): THandle; external 'gdi32.dll' name
'AddFontMemResourceEx'; stdcall;
function RemoveFontMemResourceEx(p1: THandle): BOOL; external
'gdi32.dll' name 'RemoveFontMemResourceEx'; stdcall;

procedure LoadFontFromRes(FontName: PWideChar);
var
  ResHandle: HRSRC;
  ResSize, NbFontAdded: Cardinal;
  ResAddr: HGLOBAL;
begin
  ResHandle := FindResource(system.HINSTANCE, FontName, RT_FONT);
  if ResHandle = 0 then
    RaiseLastOSError;
  ResAddr := LoadResource(system.HINSTANCE, ResHandle);
  if ResAddr = 0 then
    RaiseLastOSError;
  ResSize := SizeOfResource(DllHandle, ResHandle);
  if ResSize = 0 then
    RaiseLastOSError;
  if 0 = AddFontMemResourceEx(Pointer(ResAddr), ResSize, nil,
@NbFontAdded) then
    RaiseLastOSError;
end;


Assuming you know how to include a Font in your resources correctly
the above code should load the font from your resources just make sure
that when you do not need it anymore to call the
RemoveFontMemResourceEx a good place to do that is the main forms
constructor / destructor.

Keep in mind the above are typed directly in the forums editor and I
do not know if it will compile or not.

Just make sure the code is Windows only

----------------------------------------------------------------------
eny · 2013-05-29 17:30

You might need to signal that the font is now available for use via
Code: [Select]  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
(at least that's what I had to do in my font view program...)

<<edit>>
1001.. mm.. sounds like a fairytale

----------------------------------------------------------------------
fatmonk · 2013-05-30 08:42

Thanks both... it looks like I'm going to need a bit more help on
this, though, I'm afraid.

taazz> You say 'assuming you know how to include a font in your
resources correctly'... that's debatable! I have added the font file
to the project via the Project Inspector - my guess is that that was
probably assuming the task to be far simple than it really is. Is
there any way you could explain how I do add the font as a resource
properly and also explain a bit about the code sample you posted so
that I can understand how to use it before I just go copying and
pasting.

eny> Once I get the other bit added and compiling I'll add your
suggestion as well - what's the bit about "1001" being a fairytale
(sorry, I'm having a day of being stupid today).

-FM

----------------------------------------------------------------------
taazz · 2013-05-30 09:31

I think that the code is self explained but here it goes.

Having a resource is like having a simple array of data of variable
size and type. As you can understand so far a resource is identified
by an ID. This ID is created algorithmically by the name which must be
unique in the application or dll resource table. findResource
translates a resource name to its id, loadresource loads the resource
in to memory sizeofresource calculates the data size of the resource
and the final call AddFontMemRes will add the font to the windows
installed font table. Every call is checked if it was executed
succesfuly and if it is not then raiselastOSError is called to create
an exception with the error number and message reported by that call
to the OS making sure that you get a meaningful message instead of
silently failing, this is the standard procedure when calling api
functions.

By calling the sendmessage(....) that envy told you, you inform
windows that a new font has been loaded and at the same time windows
send a message to all running applications to refresh their copy of
font list as needed. I think that the refresh is taken care internally
for you.
You can also send the message to your application only instead of the
HWND_BROADCAST (application.MainFormHandle if I remember correctly or
something along those lines)

Now about the resource you need to create an RC file and link it in
your application using {$R myFont.rc} this will compile the RC to a
binary Res and include it in the exe's resource table. How you create
the RC I do not remember by heart, it has been more than 5 years the
last time I did something along those lines. Of course you can use any
resource editor and create a binary RES file instead of an RC and use
that in the {$R } directive.

----------------------------------------------------------------------
fatmonk · 2013-05-30 14:53

Thanks taazz,

I'm new to pascal so I'm sure your code was very self-explanatory, but
just consider me ignorant on most things. My C++ Builder experience
was years ago as well so I'm trying to get myself back up to speed
while handling different ways of doing things.

I've made some progress as follows.

- Created an lrs file with lazres.
- Added LResources to the uses clause.
- Added an initialization clause just before the end. at the end of
the Unit1.pas file with {$I myResourceFile.lrs}.

That all seems to compile OK so I assume that the resource is being
included in the exe (when I compile without the {$I clause the exe
created is 19kB smaller - though the resource file is 59kB on disk).

I've then added your code but am not sure I've put things in the
correct place.

- The const clause I have added after the uses clause but before the
type clause in Unit1.pas.
- The type declarations I have added to the end; of the TFor1 class
declaration in the existing type clause in Unit1.pas.
- The two  function declarations I've added right after that.
- The procedure I've added after my other procedures and before the
new initialization clause that's including my resource.

When I tried to compile I got an error that seemed to imply that an
end; was needed to match the record of TDesignVector so I added that
and the compile gets further than that line now.

I'm now getting another two errors though:

Code: [Select]unit1.pas(41,87) Error: Identifier not found "LPDWORD"
unit1.pas(41,149) Error: Procedure directive "STDCALL" has conflicts
with other directives
unit1.pas(41,149) Fatal: There were 2 errors compiling module,
stopping
Looking back at my explanation it's probably worth me pasting that
whole definition bit from the top of my Unit1.pas:

Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls,
  StdCtrls, Unit2, LResources;

const
    MM_MAX_NUMAXES = 16;   // font embed

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Label1: TLabel;

    procedure CloseDialog(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure showImage(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  PDesignVector = ^TDesignVector;       // font embed
  TDesignVector = packed record         // font embed
      dvReserved: DWORD;                  // font embed
      dvNumAxes: DWORD;                   // font embed
      dvValues: array[0..MM_MAX_NUMAXES-1] of Longint;     // font
embed
  end;

  function AddFontMemResourceEx(p1: Pointer; p2: DWORD; p3:
PDesignVector; p4: LPDWORD): THandle; external 'gdi32.dll' name
'AddFontMemResourceEx'; stdcall;                // font embed
  function RemoveFontMemResourceEx(p1: THandle): BOOL; external
'gdi32.dll' name 'RemoveFontMemResourceEx'; stdcall;                 
                                     // font embed


var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }  and then my procedures etc follow.

I hope that's not too much of a bombardment.

Oh, and the stupid question... how do I specify the font and resource
to load/use? I assume I make it available using
LoadFontFromRes('myResourceFile') or is it by font name as in
LoadFontFromRes('myFontName')? And do I need to then set that for the
controls that use it or will it use the font of the correct name was
specified at design time?

Finally, stupid question 2: How do I know the parameter to pass to
RemoveFontMemResourceEx?

(I'm really feeling the newbie in me with this one - but all good
learning).

Thanks,

FM

----------------------------------------------------------------------
eny · 2013-05-30 18:57

Quote from: fatmonk on May 30, 2013, 10:42:53 amwhat's the bit about
"1001" being a fairytale 1001 posts
http://en.wikipedia.org/wiki/One_Thousand_and_One_Nights

----------------------------------------------------------------------
Cyrax · 2013-05-31 06:02

Quote from: fatmonk on May 30, 2013, 04:53:30 pm...

I highly doubt that Lazarus resource format is correct way to include
embed font. You should use FPC/Windows native resource format as taazz
have explained in his/her posts.

See this link http://msdn.microsoft.com/en-
us/library/windows/desktop/ee264311(v=vs.85).aspx for more info.

----------------------------------------------------------------------
BigChimp · 2013-05-31 06:08

And
http://wiki.lazarus.freepascal.org/Lazarus_Resources#FPC_resources

----------------------------------------------------------------------
taazz · 2013-05-31 09:47

Well given all the responces so far you should have enough information
by now to make corrections to your resources and how to include them
in your application. In any case lResources is code based resources
and they are not compatible with the "file" resources that a windows
executable has. You need to create windows resource and link them in
your application that is done using 2 methods.
1) create an RC file and link it using the {$R} directive. An RC file
can be seen as the source file of a binary resource aka .res file. The
FPC tool set will detect and compile those to binary resources aka
*.res file.
2) create a .RES file and link it in using the {$R} directive. Just
use any Resource editor in the internet that can handle .res files and
add your font resource to a new file.

As for the second question I see that my procedure does not provide
the complete picture so here is a revised version of it to.
Code: [Select]function LoadFontFromRes(FontName: PWideChar):THandle;
var
  ResHandle: HRSRC;
  ResSize, NbFontAdded: Cardinal;
  ResAddr: HGLOBAL;
begin
  ResHandle := FindResource(system.HINSTANCE, FontName, RT_FONT);
  if ResHandle = 0 then
    RaiseLastOSError;
  ResAddr := LoadResource(system.HINSTANCE, ResHandle);
  if ResAddr = 0 then
    RaiseLastOSError;
  ResSize := SizeOfResource(system.HINSTANCE, ResHandle);
  if ResSize = 0 then
    RaiseLastOSError;
  Result = AddFontMemResourceEx(Pointer(ResAddr), ResSize, nil,
@NbFontAdded)
  if Result = 0 then
    RaiseLastOSError;
end;
Save the result of the function to a variable and use that variable to
pass to the RemoveFontMemResourceEx call.

----------------------------------------------------------------------
fatmonk · 2013-05-31 12:56

I'm slowly getting there... possibly.

- Have created a resource file (.rc) from a template on MSDN that
points to my ttf file. (I didn't realise it was just a text file!)
- I've changed the {$I.... in the initialize clause at the end of
Unit1.pas to a {$R... statement now pointing at the new .rc file
rather than the .lrs file.
- Have updated the LoadFont... function to taazz's new version.

I was still getting the error:
Code: [Select]unit1.pas(41,87) Error: Identifier not found "LPDWORD"
but adding Windows to the uses clause for Unit1.pas seems to have
cured that - is that the correct fix?

I still, however, have the error:
Code: [Select]unit1.pas(41,149) Error: Procedure directive "STDCALL"
has conflicts with other directives
so I can't compile at the moment.

Then I need to figure out how to actually assign the font to the
controls that I want to use it on the TForm.

As you can see I'm really struggling with this one as it's completely
new territory for me.

Thanks,

FM

----------------------------------------------------------------------
taazz · 2013-05-31 13:22

Quote from: fatmonk on May 31, 2013, 02:56:13 pmI'm slowly getting
there... possibly.

- Have created a resource file (.rc) from a template on MSDN that
points to my ttf file. (I didn't realise it was just a text file!)
- I've changed the {$I.... in the initialize clause at the end of
Unit1.pas to a {$R... statement now pointing at the new .rc file
rather than the .lrs file.
- Have updated the LoadFont... function to taazz's new version.

I was still getting the error:
Code: [Select]unit1.pas(41,87) Error: Identifier not found "LPDWORD"
yes using the unit windows is required.

Quote from: fatmonk on May 31, 2013, 02:56:13 pmbut adding Windows to
the uses clause for Unit1.pas seems to have cured that - is that the
correct fix?

I still, however, have the error:
Code: [Select]unit1.pas(41,149) Error: Procedure directive "STDCALL"
has conflicts with other directives
so I can't compile at the moment.

Then I need to figure out how to actually assign the font to the
controls that I want to use it on the TForm.

As you can see I'm really struggling with this one as it's completely
new territory for me.

Thanks,

FM

Oh must have been half asleep when writing the method definitions you
need to put stdcall before everything else something alone the lines
of Code: [Select]function AddFontMemResourceEx(p1: Pointer; p2: DWORD;
p3: PDesignVector; p4: LPDWORD): THandle; stdcall external 'gdi32.dll'
name 'AddFontMemResourceEx';
function RemoveFontMemResourceEx(p1: THandle): BOOL; stdcall external
'gdi32.dll' name 'RemoveFontMemResourceEx';
 that should be enough.

To use the font in your controls you need to first send the message
that eny talked about after the call to the loadFontFromRes call and
let the application process the messages eg.
Code: [Select]var
  vFnt : THandle;
begin
  vFnt := LoadFontFromRes('MyResFontName');
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
  Application.ProcessMessages;
end;
That should refresh your application to be able to recognise the font
name after that setting the Control.Font.Name to the font's name will
be the only thing you need to use it. Keep in mind that the font's
name is not the resource name you defined in the RC file to make
things simple just install the font in your development machine and
select it in a control that supports fonts the name you see on the
object inspector is the name you must set in order to use it.

----------------------------------------------------------------------
fatmonk · 2013-06-03 15:11

Thanks all,

It took a bit of fiddling, but I believe I'm there... I have the font
displaying in the application on a box where that font is not
installed which is exactly what I needed.

(Now I just have to pick over taazz's code so that I can fully
understand it - the only way I'll learn).

Thanks again, it's very much appreciated,

FM

----------------------------------------------------------------------
Sait™ · 2016-08-03 11:45

Quote from: taazz on May 29, 2013, 07:24:37 pmCode: [Select]const
    MM_MAX_NUMAXES = 16;
type
  PDesignVector = ^TDesignVector;
  TDesignVector = packed record
    dvReserved: DWORD;
    dvNumAxes: DWORD;
    dvValues: array[0..MM_MAX_NUMAXES-1] of Longint;
  end;

function AddFontMemResourceEx(p1: Pointer; p2: DWORD; p3:
PDesignVector; p4: LPDWORD): THandle; external 'gdi32.dll' name
'AddFontMemResourceEx'; stdcall;
function RemoveFontMemResourceEx(p1: THandle): BOOL; external
'gdi32.dll' name 'RemoveFontMemResourceEx'; stdcall;

procedure LoadFontFromRes(FontName: PWideChar);
var
  ResHandle: HRSRC;
  ResSize, NbFontAdded: Cardinal;
  ResAddr: HGLOBAL;
begin
  ResHandle := FindResource(system.HINSTANCE, FontName, RT_FONT);
  if ResHandle = 0 then
    RaiseLastOSError;
  ResAddr := LoadResource(system.HINSTANCE, ResHandle);
  if ResAddr = 0 then
    RaiseLastOSError;
  ResSize := SizeOfResource(DllHandle, ResHandle);
  if ResSize = 0 then
    RaiseLastOSError;
  if 0 = AddFontMemResourceEx(Pointer(ResAddr), ResSize, nil,
@NbFontAdded) then
    RaiseLastOSError;
end;


Can I load the font from raw file instead of compling font to resource
data?

----------------------------------------------------------------------
RAW · 2016-10-07 21:12

QuoteCan I load the font from raw file instead of compling font to
resource data?
raw file ???


I guess this is the easy way without RES and stress... 

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 Unit
Unit1; {$mode objfpc}{$H+} Interface USES  Windows, Classes, SysUtils,
Forms, Controls;  TYPE  TForm1 = Class(TForm)   Procedure FormCreate
(Sender: TObject);   Procedure FormClose  (Sender: TObject;  Var
CloseAction: TCloseAction);  End;  CONST  MM_MAX_NUMAXES =  16; 
FR_PRIVATE     = $10;  FR_NOT_ENUM    = $20;  TYPE  PDesignVector =
^TDesignVector;  TDesignVector = Packed Record   dvReserved: DWORD; 
 dvNumAxes : DWORD;   dvValues  : Array[0..MM_MAX_NUMAXES-1] Of
LongInt;  End;  VAR  Form1: TForm1;   Function AddFontResourceEx  
 (Dir : PAnsiChar;                                Flag: Cardinal;    
                          PDV : PDesignVector): Int64; StdCall;      
                        External 'GDI32.dll' Name
'AddFontResourceExA';  Function RemoveFontResourceEx (Dir :
PAnsiChar;                                Flag: Cardinal;            
                  PDV : PDesignVector): Int64; StdCall;              
                External 'GDI32.dll' Name
'RemoveFontResourceExA';  Implementation {$R *.lfm}  Procedure
LoadFonts;  Var   AppPath: String; Begin  AppPath:=
ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'FONTS\MONO.ttf')   Then    If
AddFontResourceEx(PAnsiChar(AppPath+'FONTS\MONO.ttf'), FR_Private,
Nil) <> 0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0,
0); End;  Procedure RemoveFonts;  Var   AppPath: String; Begin 
AppPath:= ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'FONTS\MONO.ttf')   Then    If
RemoveFontResourceEx(PAnsiChar(AppPath+'FONTS\MONO.ttf'), FR_Private,
Nil) <> 0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0,
0); End;  Procedure TForm1.FormCreate(Sender: TObject); Begin 
LoadFonts; End;  Procedure TForm1.FormClose(Sender: TObject; var
CloseAction: TCloseAction); Begin  RemoveFonts; End;  End.

----------------------------------------------------------------------
majid.ebru · 2017-06-29 12:06

Quote from: RAW on October 07, 2016, 11:12:01 pmQuoteCan I load the
font from raw file instead of compling font to resource data?
raw file ???


I guess this is the easy way without RES and stress... 

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 Unit
Unit1; {$mode objfpc}{$H+} Interface USES  Windows, Classes, SysUtils,
Forms, Controls;  TYPE  TForm1 = Class(TForm)   Procedure FormCreate
(Sender: TObject);   Procedure FormClose  (Sender: TObject;  Var
CloseAction: TCloseAction);  End;  CONST  MM_MAX_NUMAXES =  16; 
FR_PRIVATE     = $10;  FR_NOT_ENUM    = $20;  TYPE  PDesignVector =
^TDesignVector;  TDesignVector = Packed Record   dvReserved: DWORD; 
 dvNumAxes : DWORD;   dvValues  : Array[0..MM_MAX_NUMAXES-1] Of
LongInt;  End;  VAR  Form1: TForm1;   Function AddFontResourceEx  
 (Dir : PAnsiChar;                                Flag: Cardinal;    
                          PDV : PDesignVector): Int64; StdCall;      
                        External 'GDI32.dll' Name
'AddFontResourceExA';  Function RemoveFontResourceEx (Dir :
PAnsiChar;                                Flag: Cardinal;            
                  PDV : PDesignVector): Int64; StdCall;              
                External 'GDI32.dll' Name
'RemoveFontResourceExA';  Implementation {$R *.lfm}  Procedure
LoadFonts;  Var   AppPath: String; Begin  AppPath:=
ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'FONTS\MONO.ttf')   Then    If
AddFontResourceEx(PAnsiChar(AppPath+'FONTS\MONO.ttf'), FR_Private,
Nil) <> 0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0,
0); End;  Procedure RemoveFonts;  Var   AppPath: String; Begin 
AppPath:= ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'FONTS\MONO.ttf')   Then    If
RemoveFontResourceEx(PAnsiChar(AppPath+'FONTS\MONO.ttf'), FR_Private,
Nil) <> 0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0,
0); End;  Procedure TForm1.FormCreate(Sender: TObject); Begin 
LoadFonts; End;  Procedure TForm1.FormClose(Sender: TObject; var
CloseAction: TCloseAction); Begin  RemoveFonts; End;  End. 
Hi
sorry

now how can i use this font ?
how can i set this fonr for Label?

----------------------------------------------------------------------
RAW · 2017-06-29 15:06

You can use any loaded font the usual way:

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
Label1.Font.Name:= 'Lucida Console'; 

EDIT:
You need the real font name and not the name of the file.
For example:
FileName: MONT BLACK.otf
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
Label1.Font.Name:= 'Montserrat Black';

----------------------------------------------------------------------
majid.ebru · 2017-06-29 15:47

don't work???
.
in code use 'MONO.ttf' font?!?
.
i copy my font in project folder and rename it to 'MONO.ttf' then i
copy  'GDI32.dll' in project folder.
and write this 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 procedure
TForm1.Label1Click(Sender: TObject);begin  Label1.Font.Name :=
'MONO.ttf';end; 
but font of label doesn't change?!
.
.
all codes :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 unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,  ExtCtrls ,
Windows; type   { TForm1 }   TForm1 = class(TForm)    Image1: TImage; 
  Label1: TLabel;    procedure FormClose(Sender: TObject; var
CloseAction: TCloseAction);    procedure FormCreate(Sender: TObject); 
  procedure Label1Click(Sender: TObject);  private    { private
declarations }  public    { public declarations }  end;   CONST 
MM_MAX_NUMAXES =  16;  FR_PRIVATE     = $10;  FR_NOT_ENUM    =
$20;  TYPE  PDesignVector = ^TDesignVector;  TDesignVector = Packed
Record   dvReserved: DWORD;   dvNumAxes : DWORD;   dvValues  :
Array[0..MM_MAX_NUMAXES-1] Of LongInt;  End;  var  Form1:
TForm1;   Function AddFontResourceEx    (Dir : PAnsiChar;            
                  Flag: Cardinal;                                PDV :
PDesignVector): Int64; StdCall;                               
External 'GDI32.dll' Name 'AddFontResourceExA';  Function
RemoveFontResourceEx (Dir : PAnsiChar;                               
Flag: Cardinal;                                PDV : PDesignVector):
Int64; StdCall;                                External 'GDI32.dll'
Name 'RemoveFontResourceExA';   implementation {$R *.lfm} Procedure
LoadFonts;  Var   AppPath: String; Begin  AppPath:=
ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'MONO.ttf')   Then    If
AddFontResourceEx(PAnsiChar(AppPath+'MONO.ttf'), FR_Private, Nil) <>
0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0,
0); End;  Procedure RemoveFonts;  Var   AppPath: String; Begin 
AppPath:= ExtractFilePath(Application.ExeName);    If
FileExists(AppPath+'MONO.ttf')   Then    If
RemoveFontResourceEx(PAnsiChar(AppPath+'MONO.ttf'), FR_Private, Nil)
<> 0    Then SendMessage(Form1.Handle, WM_FONTCHANGE, 0, 0); End; {
TForm1 } Procedure TForm1.FormCreate(Sender: TObject); Begin 
LoadFonts; End; procedure TForm1.Label1Click(Sender: TObject);begin 
Label1.Font.Name := 'MONO.ttf';end;  Procedure
TForm1.FormClose(Sender: TObject; var CloseAction:
TCloseAction); Begin  RemoveFonts; End;   end.

----------------------------------------------------------------------
Thaddy · 2017-06-29 16:04

Try SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

----------------------------------------------------------------------
majid.ebru · 2017-06-29 16:20

Quote from: Thaddy on June 29, 2017, 06:04:50 pmTry
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);

sorry NO work

----------------------------------------------------------------------
howardpc · 2017-06-29 16:38

Don't rename your font.
Use its actual filename in the line
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 If
AddFontResourceEx(PAnsiChar(AppPath+'filename_of_your_font.ttf'),
FR_Private, Nil) <> 0and use the font's name (not the font's filename)
in the line
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
Label1.Font.Name := fontname;

----------------------------------------------------------------------
majid.ebru · 2017-06-29 17:03

Thank you

it's work

----------------------------------------------------------------------
RAW · 2017-06-29 18:17

Being able to read is an advantage...

----------------------------------------------------------------------
nnm4evr · 2017-07-10 08:14

Doesn't work for me. I use Delphi 7, OS Win 7 Ultim x64. Attach
source.

----------------------------------------------------------------------
ASerge · 2017-07-10 20:06

Quote from: nnm4evr on July 10, 2017, 10:14:27 amDoesn't work for me.
I use Delphi 7, OS Win 7 Ultim x64. Attach source.
In your example a lot of superfluous. Here it works in Delphi 7 and in
Lazarus
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 uses
Windows; {$IFDEF FPC}  const FR_PRIVATE = $10;  function
AddFontResourceExA(FontFileName: PAnsiChar; Flags: DWORD;    Reserved:
Pointer): Integer; stdcall; external gdi32;{$ENDIF} procedure
TForm1.Button1Click(Sender: TObject);begin  if FFontLoaded then   
Label1.Font.Name := 'Auricom Regular';end; procedure
TForm1.Button2Click(Sender: TObject);begin  Label1.ParentFont :=
True;end; procedure TForm1.FormCreate(Sender: TObject);var 
FontFileName: string;begin  FontFileName :=
ExtractFilePath(Application.ExeName) + 'Auricom_Regular - copy.ttf'; 
if FileExists(FontFileName) then    FFontLoaded :=
AddFontResourceExA(Pointer(FontFileName), FR_PRIVATE, nil) > 0;end;

----------------------------------------------------------------------
nnm4evr · 2017-07-11 01:21

This code work only in WinXP, i test it on old nootebok with WinXP
SP3. Doesn't work on Win7 on my PC. Not tested on Win8-Win10. Program
with this code need to work from WinXP to Win10.

(Sorry for Google.Translate)

----------------------------------------------------------------------
RAW · 2017-07-11 02:11

@nnm4evr

What's your problem ??? Error ???
This runs fine on D7 (W7 x64).

On D7 RemoveFontResourceEx = LongBool !!!

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 Unit
Unit1; Interface USES  Windows,  Messages, Classes,  SysUtils, Forms,
  Controls,  StdCtrls;  TYPE  TForm1 = Class(TForm)    Label1:
TLabel;    Procedure FormCreate (Sender: TObject);   Procedure
FormClose  (Sender: TObject;  Var CloseAction: TCloseAction); 
 Procedure FormClick  (Sender: TObject);  End;  VAR  Form1:
TForm1; Implementation {$R *.dfm}  Procedure LoadFonts;  Var 
 strAppPath: String; Begin  strAppPath:=
ExtractFilePath(Application.ExeName);    If
FileExists(strAppPath+'FONTS\MONT BLACK.otf')   Then    If
AddFontResourceEx(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'),      
                 FR_PRIVATE, Nil) <> 0     Then
SendMessage(Form1.Handle, WM_FONTCHANGE, 0, 0); End;  Procedure
RemoveFonts;  Var   strAppPath: String; Begin  strAppPath:=
ExtractFilePath(Application.ExeName);    If
FileExists(strAppPath+'FONTS\MONT BLACK.otf')   Then    If
RemoveFontResourceEx(PAnsiChar(strAppPath+'FONTS\MONT BLACK.otf'),   
                       FR_PRIVATE, Nil)     Then
SendMessage(Form1.Handle, WM_FONTCHANGE, 0, 0); End;  Procedure
TForm1.FormCreate(Sender: TObject); Begin  LoadFonts; End;  Procedure
TForm1.FormClose(Sender: TObject; Var CloseAction:
TCloseAction); Begin  RemoveFonts; End;  Procedure
TForm1.FormClick(Sender: TObject); Begin  Label1.Font.Name:=
'Montserrat Black';  Label1.Font.Size:= 50; End; END.

EDIT:
This runs fine too in D7 AND in LAZARUS !!! (W7 x64)

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 UNIT
Unit1; {$IFDEF FPC}  {$MODE OBJFPC}{$H+}{$J-} {$ENDIF} Interface USES 
Windows, {$IFNDEF FPC}  Messages, {$ENDIF}  Classes, SysUtils, Forms,
Controls, StdCtrls;  TYPE  TForm1 = Class(TForm)    Label1: TLabel;  
 Procedure FormCreate (Sender: TObject);   Procedure FormClick
 (Sender: TObject);   Procedure FormClose  (Sender: TObject;  Var
CloseAction: TCloseAction);  End;  VAR  Form1: TForm1;   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.

----------------------------------------------------------------------
nnm4evr · 2017-07-11 08:28

On Win7 Label just disapper when i apply "my" font. On WinXP this
methods works fine. I record small video (less 1 minute) what happens
- YouTube

----------------------------------------------------------------------
Josh · 2017-07-11 09:19

@nnm4evr
I had a quick look at your video, is the gdi32.dll the same one on the
2 different windows versions?
If it is the same one, the majority of windows/systemxx dll are
version / service pack specific.
If you delete gdi32.dll from your project folder, does it work, as
your app should then use your windows gdi32.dll

----------------------------------------------------------------------
rvk · 2017-07-11 09:37

Quote from: nnm4evr on July 11, 2017, 10:28:41 amOn Win7 Label just
disapper when i apply "my" font. On WinXP this methods works fine. I
record small video (less 1 minute) what happens - YouTube
Also note that loading from filesystem doesn't always work. For
instance if you have the ttf file in your user-directory, the OS can't
reach it and will give you file not found error. This shouldn't be an
issue for you now because you load it from E:\

Second... what kind of error do you get when you add RaiseLastOSError
when the result of LoadFont is 0.
(you changed the source for your youtube because I can't see the
showmessage for successful loading in WinXP)

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
LoadFonts;begin  if
FileExists(ExtractFilePath(Application.ExeName)+'Auricom_Regular.ttf')
then    if AddFontResourceEx(PAnsiChar(ExtractFilePath(Application.Exe
Name)+'Auricom_Regular.ttf'), FR_Private, Nil) <> 0 then    begin    
SendMessage(Form1.Handle, WM_FONTCHANGE, 0, 0);      ShowMessage('Font
Installed!');    end else RaiseLastOSError;end;
Do you get the Font Installed message or do you get an OS-error?

And last... like josh already mentioned. DON'T distribute GDI32.dll.
(I see they are the same)
It should already be installed in your Windows-directory. You are
likely to distribute the wrong one for your OS.
(i.e. 32 or 64 bit and differences for XP through 10)
So never ever distribute that file.

PS. Maybe I missed something but why are you saving the ttf file to
disk and load it from there? It is possible to load it directly from
the resource file. So you don't have to save the ttf first. (Example
is earlier in this thread)

----------------------------------------------------------------------
rvk · 2017-07-11 10:14

O, and one other (not so small) thing.
You have your label1 charset set to a russion charset.
But your Auricom_Regular.ttf doesn't contain such charset.
So the assigning of Font.Name to 'Auricom Regular' fails because the
charset requirement can't be met.
Set it to DEFAULT_CHARSET and it will work (together with removing the
gdi32.dll) !!

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.Button3Click(Sender: TObject);begin  Label1.Font.Charset :=
DEFAULT_CHARSET;  Label1.Font.Size := 12;  Label1.Font.Name :=
'Auricom Regular';end;

----------------------------------------------------------------------
nnm4evr · 2017-07-12 04:25

Still doesn't work on Win 7. Message "Font Installed!" showing, but
Label still disappear when i push button to apply "My" Font. GDI32.DLL
i remove. On Win XP all works fine. Font Auricom Regular have russian
symbols, but i change charset to Default, doesn't help. Here a new
small video - YouTube. And my sources without trash from my last
sources (in archive only sorces and font dll w/o exe file).

(And again - Sorry for my English)

----------------------------------------------------------------------
rvk · 2017-07-12 07:15

It works perfectly for me (Windows 10, Delphi 10.2) after changing
some ansi stuff because of unicode.

BUT... I still see that GDI32.DLL from 2010 in your directory in that
youtube video on Windows 7.
Please REMOVE IT and try again.

----------------------------------------------------------------------
nnm4evr · 2017-07-12 09:20

GDI32.DLL removed, but still no effect. I use Delphi 7, but a have
installed Embarcodero Delphi 2010 (from RAD Studio 2010), i'll try
this code on it and answer.

No, doesn't work on 2010. This is strange. I'll try to launch app on
my frends computers with Win7 and Win10 and answer.

----------------------------------------------------------------------
rvk · 2017-07-12 10:27

Trying on another machine might be a good idea.

Another would be to try loading the font directly from the resource
without the step of saving it to disk (with AddFontMemResourceEx).

Try the following:

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
hFontRes: Cardinal; // add this line procedure
TForm1.FormCreate(Sender: TObject);var  FontFileName: string; 
FontCount1: Cardinal; // <--- add this onebegin  DLLInstance :=
LoadLibrary('FNTTest.dll'); // çàãðóçêà áèáëèîòåêè Load DLL  if
DLLInstance = 0 then  begin // Ïðîâåðêà çàãðóçêè Load Check   
MessageDlg('Áèáëèîòåêà FNTTest.dll íå íàéäåíà èëè ïîâðåæäåíà!' +
#13#10 + 'Ïîæàëóéñòà ïåðåóñòàíîâèòå ïðîãðàììó.', mtError, [mbOK], 0);
// Ïèøåì ñâîå ðóãàòåëüñòî ;-) Message -> DLL Not loaded (or not
found)    Application.Terminate;  end;  FontStream :=
TResourceStream.Create(DLLInstance, 'MyFONT', rt_RCData);   // Now
load the font directly from stream  hFontRes :=
AddFontMemResourceEx(FontStream.Memory, FontStream.Size, nil,
@FontCount1);  if FontCount1 = 1 then ShowMessage('Font Installed from
memory!') else ShowMessage('Error installing font!');   // comment out
the following lines 
//FontStream.SaveToFile(ExtractFilePath(Application.ExeName) +
'Auricom_Regular.ttf');  //LoadFonts; end;

----------------------------------------------------------------------
ASerge · 2017-07-13 15:33

Quote from: nnm4evr on July 11, 2017, 03:21:55 amThis code work only
in WinXP, i test it on old nootebok with WinXP SP3. Doesn't work on
Win7 on my PC.
Did you try my short code without any dll and files savings? Just
create an empty form, a label, a pair of buttons and the the code (and
private field, it's easy to guess what that is). Put the font file in
the program directory and try. I have Windows 7 and it works. Compiled
with Delphi 7 or Lazarus.