Как я могу временно загрузить шрифт?
Вопрос
Мне нужно временно загрузить некоторые шрифты в мою программу.Предпочтительно из файла ресурсов 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;
Другие советы
я нашел этот с Гуглом.Я вырезал и вставил соответствующий код ниже.
Вам необходимо добавить шрифт в файл ресурсов:
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;