FIREMONKEY - 대체 글꼴로드

Question

Delphi Firemonkey 응용 프로그램에서 외부 글꼴을로드하고 싶습니다.

어떻게 할 수 있습니까?

Answer 1

FireMonkey에서 작동하는지 모르지만이 코드는 표준 Delphi 응용 프로그램에 사용자 정의 글꼴을로드하려고 할 때 유용했습니다.

unit UExternalFonts; 

interface 

uses 
    Windows, SysUtils, Messages, Classes, Generics.Collections; 

type 
    { .: TExternalFonts :. } 
    TExternalFonts = class sealed(TList<HFONT>); 

var 
    ExternalFonts: TExternalFonts; 

function AddExternalFont(const AFileName: String): HFONT; overload; 
function AddExternalFont(const AStream: TStream): HFONT; overload; 

implementation 

{ .: DoCleanup :. } 
procedure DoCleanup(); 
var 
    I: Integer; 
begin 
    for I := ExternalFonts.Count -1 downto 0 do 
    begin 
    RemoveFontMemResourceEx(ExternalFonts[I]); 
    ExternalFonts.Delete(I); 
    //SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
    end; 
end; 

{ .: AddExternalFont :. } 
function AddExternalFont(const AFileName: String): HFONT; overload; 
var 
    FS: TFileStream; 
begin 
    Result := 0; 

    if not FileExists(AFileName) then 
    exit; 

    FS := TFileStream.Create(AFileName, fmOpenRead + fmShareExclusive); 
    try 
    Result := AddExternalFont(FS); 
    finally 
    FS.Free(); 
    end; 
end; 

{ .: AddExternalFont :. } 
function AddExternalFont(const AStream: TStream): HFONT; overload; 
var 
    MS: TMemoryStream; 
    Temp: DWORD; 
begin 
    Result := 0; 

    if not Assigned(AStream) then 
    exit; 

    Temp := 1; 
    MS := TMemoryStream.Create(); 
    try 
    MS.CopyFrom(AStream, 0); 

    Result := AddFontMemResourceEx(MS.Memory, MS.Size, nil, @Temp); 
    if (Result <> 0) then 
     ExternalFonts.Add(Result); 
    //SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); 
    finally 
    MS.Free(); 
    end; 
end; 

initialization 
    ExternalFonts := TExternalFonts.Create(); 

finalization 
    DoCleanup(); 
    ExternalFonts.Free(); 

end.