質問
プログラムにいくつかのフォントを一時的にロードする必要があります。できれば dll リソース ファイルから。
解決
そして、これが 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;
他のヒント
見つけました これ Googleと。以下の関連コードをカットアンドペーストしました。
フォントをリソース ファイルに追加する必要があります。
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);
以下は、実行可能ファイル内からフォントをロードして利用可能にするコードです (つまり、フォントは通常 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;
所属していません StackOverflow