_Using my own FONT file without having it in the Windows\Font directory !

Hi, I would like to know how to map my program to a specific FONT file (*.ttf) which is in my *.exe directory but not registered to the Windows system.

I'm using Delphi 3 standard.

I'm doing this because i have a DBCS font (4 MB) and, while I am distributing the program from a CD, I don't want the user to install it(the font file) then remove it.......

Your help will be appreciated.

Wein
98-09-19

trustno1wei@hotmail.com
WeinAsked:
Who is Participating?
 
erajojConnect With a Mentor Commented:
Hi,
Here's an example of how to do it.
I haven't found a good way to retrieve the font's face name so I give you this, working but, lame solution. Here's what happens:

1. Enumeration of existing screen fonts.
2. Loading of new font(s)(more than one font can reside in a font file).
3. New enumeration of screen fonts.
4. Removal of old font names.

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; export;
  {$IFDEF WIN32} stdcall; {$ENDIF}
begin
  TStrings( Data ).Add( StrPas( LogFont.lfFaceName ) );
  Result := 1;
end;

function TForm1.LoadFont( sFontFilename: string; NewFontNames: TStrings ): Boolean;
var
  iOldFontCount   : Integer;
  rgsFontNames    : TStringList;
  Proc            : TFarProc;
begin
  Result := False;
  Proc   := MakeProcInstance( @EnumFontsProc, hInstance );
  if FileExists( sFontFileName ) then
  begin
    rgsFontNames := TStringList.Create;
    {1} EnumFonts( GetDC( 0 ), nil, Proc, Pointer( rgsFontNames ) ); // get all current font names
    iOldFontCount := rgsFontNames.Count; rgsFontNames.Clear;     // no need for these anymore
    {2} if AddFontResource( PChar( sFontFileName ) ) <> 0 then
    begin
      Result := True;
      SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
      {3} EnumFonts( GetDC( 0 ), nil, Proc, Pointer( rgsFontNames ) ); // get all current font names
      {4} for iOldFontCount := 1 to iOldFontCount do rgsFontNames.Delete( 0 ); // delete all old names, new names are last
      if Assigned( NewFontNames ) then NewFontNames.AddStrings( rgsFontNames ); // copy them if possible
    end;
    rgsFontNames.Free;
  end;
end;

function TForm1.UnLoadFont( sFontFilename: string ): Boolean;
begin
  Result := RemoveFontResource( PChar( sFontFilename ) );
  SendMessage( HWND_BROADCAST, WM_FONTCHANGE, 0, 0 );
end;

And here's how to use it:
  LoadFont( ExtractFilePath( ParamStr( 0 ) ) + 'myfont.ttf', ListBox1.Items );

Don't forget UnLoadFont( ExtractFilePath( ParamStr( 0 ) ) + 'myfont.ttf' ) in your destructor or whereever you want it.

/// John
0
 
WeinAuthor Commented:
This is really good and works quickly.

I'm wondering if I use it with a 5MB font, what will happen.
Well, thanks for you help.

When you load the file, it registers to the system without copying the file, is that right?

If I forget unloading the font, what will happen?
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.