Solved

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

Posted on 1998-09-19
2
220 Views
Last Modified: 2013-12-03
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
0
Comment
Question by:Wein
2 Comments
 
LVL 4

Accepted Solution

by:
erajoj earned 60 total points
ID: 1340296
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
 

Author Comment

by:Wein
ID: 1340297
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

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

828 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question