How can i temporarily load a font?

Question

I need to load some fonts temporarily in my program. Preferably from a dll resource file.

Answer 1

Here's some code that will load/make available the font from inside your executable (ie, the font was embedded as a resource, rather than something you had to install into Windows generally).

Note that the font is available to any application until your program gets rid of it. I don't know how useful you'll find this, but I have used it a few times. I've never put the font into a dll (I prefer this 'embed into the exe' approach) but don't imagine it changes things too much.

procedure TForm1.FormCreate(Sender: TObject);
var
    ResStream : TResourceStream;
    sFileName : string;
begin
    sFileName:=ExtractFilePath(Application.ExeName)+'SWISFONT.TTF';

    ResStream:=nil;
    try
     ResStream:=TResourceStream.Create(hInstance, 'Swisfont', RT_RCDATA);
     try
      ResStream.SaveToFile(sFileName);
     except
      on E:EFCreateError Do ShowMessage(E.Message);
     end;
    finally
     ResStream.Free;
    end;

    AddFontResource(PChar(sFileName));
    SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;


procedure TForm1.FormDestroy(Sender: TObject);
var
    sFile:string;
begin
    sFile:=ExtractFilePath(Application.ExeName)+'SWISFONT.TTF';
    if FileExists(sFile) then
    begin
     RemoveFontResource(PChar(sFile));
     SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
     DeleteFile(sFile);
    end;
end;

Answer 2

And here a Delphi version:

procedure LoadFontFromDll(const DllName, FontName: PWideChar);
var
  DllHandle: HMODULE;
  ResHandle: HRSRC;
  ResSize, NbFontAdded: Cardinal;
  ResAddr: HGLOBAL;
begin
  DllHandle := LoadLibrary(DllName);
  if DllHandle = 0 then
    RaiseLastOSError;
  ResHandle := FindResource(DllHandle, FontName, RT_FONT);
  if ResHandle = 0 then
    RaiseLastOSError;
  ResAddr := LoadResource(DllHandle, 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;

to be used like:

var
  FontName: PChar;
  FontHandle: THandle;
...
  FontName := 'DEJAVUSANS';
  LoadFontFromDll('Project1.dll' , FontName);
  FontHandle := CreateFont(0, 0, 0, 0, FW_NORMAL, 0, 0, 0, DEFAULT_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH,
    FontName);
  if FontHandle = 0 then
    RaiseLastOSError;