Font dynamisch laden (ohne Installieren)

[Flocke]

Die Schriftartenanzeige von Windows (FONTVIEW.EXE) benutzt die API-Funktionen AddFontResourceW und RemoveFontResourceW immer, d.h. es wird nicht überprüft, ob die Schriftart bereits installiert ist.

Die weiteren Informationen über die Schrift erhält das Programm über die undokumentierte Funktion GetFontResourceInfoW.

Es gibt übrigens *NUR* die Unicode-Version dieser Funktion - daher wird das Ding unter 95/98/ME nicht existieren. Unter 95c gibt's "GetFontResourceInfo", das liefert aber immer false (not implemented). Unter 98/ME kann ich es hier nicht prüfen.

Hier ein kleines Beispiel:

Delphi-Quellcode:

procedure PrintFontToCanvas(Canvas: TCanvas; Font: WideString);
type
  TGetFontResourceInfoW = function(Name: PWideChar; var BufSize: Cardinal;
    Buffer: pointer; InfoType: Cardinal): LongBool; stdcall;
var
  naf, k, y: integer;
  gfri: TGetFontResourceInfoW;
  lf: array of TLogFontW;
  lfsz: Cardinal;
  hfnt: HFONT;
  Name: WideString;
begin
  gfri := GetProcAddress(GetModuleHandle('gdi32.dll'), 'GetFontResourceInfoW');
  if @gfri = nil then
    raise Exception.Create('GetFontResourceInfoW in gdi32.dll nicht gefunden');

  if LowerCase(ExtractFileExt(Font)) = '.pfm' then
    Font := Font + '|' + ChangeFileExt(Font, '.pfb');

  naf := AddFontResourceW(PWideChar(Font));
  try
    if naf > 0 then
    begin
      SetLength(lf, naf);
      lfsz := naf * SizeOf(TLogFontW);
      if not gfri(PWideChar(Font), lfsz, @lf[0], 2) then
        raise Exception.Create('GetFontResourceInfoW fehlgeschlagen');

      y := 0;

      naf := lfsz div SizeOf(TLogFont);
      for k := 0 to naf - 1 do
      begin
        hfnt := CreateFontIndirectW(lf[k]);
        try
          Name := lf[k].lfFaceName;

          Canvas.Font.Handle := hfnt;
          Canvas.TextOut(0, y, Name);
          inc(y, Canvas.TextHeight('X'));
          Canvas.TextOut(0, y, 'The quick brown fox jumps over the lazy dog');
          inc(y, Canvas.TextHeight('X'));
          Canvas.Font.Handle := 0;
        finally
          DeleteObject(hfnt);
        end;
      end;
    end;
  finally
    RemoveFontResourceW(PWideChar(Font));
  end;
end;