代码之家 › 专栏 › 技术社区 › Tom

如何临时加载字体?

winapi delphi

Tom · 技术社区 · 16 年前

我需要在我的程序中临时加载一些字体。最好是从dll资源文件。

3 回复 | 直到 16 年前

Francesca 16 年前

这里是Delphi版本:

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;

要像这样使用:

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;

Brian Matthews 16 年前

我发现 this 与谷歌合作。我已经剪了&将相关代码粘贴到下面。


34 FONT "myfont.ttf"

下面的C代码将从DLL资源加载字体,并在使用完毕后将其从内存中释放。

DWORD   Count;
HMODULE Module   = LoadLibrary("mylib.dll");
HRSRC   Resource = FindResource(Module,MAKEINTRESOURCE(34),RT_FONT);
DWORD   Length   = SizeofResource(Module,Resource);
HGLOBAL Address  = LoadResource(Module,Resource);
HANDLE  Handle   = AddFontMemResourceEx(Address,Length,0,&Count);

/* Use the font here... */

RemoveFontMemResourceEx(Handle);
FreeLibrary(Module);

robsoft 16 年前

下面是一些代码,可以从可执行文件中加载/使用字体(即,字体是作为资源嵌入的,而不是通常必须安装到Windows中的东西)。

请注意,该字体可用于任何我不知道你会觉得这有多有用,但我已经用过好几次了。我从未将字体放入dll(我更喜欢这种“嵌入exe”的方法),但不要认为它会改变太多东西。

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;