I don't know platforms other than Windows well, but I can add a bit of myself about Windows.
So far, all information I found is about using winAPI for this (gdi function AddFontMemResourceEx specifically), like this:
Not only, there is another function called
AddFontResourceExW (and
RemoveFontResourceEx for removal).
I'm using it in my tool for Tetris championships, where the fonts are loaded from external files into memory, for private use (all fonts with the
.ttf and
.otf extensions located in the
fonts/ subdirectory). This method is also good, because it also does not modify the user's system, and besides, you do not need to modify the resources of the executable to change the font set.
Below is a copy of the entire unit from my tool. At one time I was looking for an implementation of something like this and did not find a specific example, which is why I leave the code for others.
unit Tool.Fonts;
{$MODE OBJFPC}{$LONGSTRINGS ON}
interface
uses
FGL;
type
TFontsMap = class(specialize TFPGMap<WideString, LongInt>)
private
procedure ListFonts(const APath: String);
public
procedure LoadFonts();
procedure UnloadFonts();
end;
type
TFonts = class(TObject)
private
FFonts: TFontsMap;
public
constructor Create();
destructor Destroy(); override;
public
procedure Load(const APath: String);
procedure Unload();
end;
implementation
uses
LazUTF8,
SysUtils;
procedure TFontsMap.ListFonts(const APath: String);
var
FoundItem: TSearchRec;
FontName: WideString;
begin
if FindFirst(APath + '*', faAnyFile, FoundItem) = 0 then
try
repeat
if (FoundItem.Name = '.') or (FoundItem.Name = '..') then Continue;
if FoundItem.Attr and faDirectory = faDirectory then
ListFonts(APath + FoundItem.Name + '\')
else
if String(ExtractFileExt(FoundItem.Name)).ToLower().IndexOfAny(['.ttf', '.otf']) <> -1 then
begin
FontName := UTF8ToUTF16(APath + FoundItem.Name);
Add(FontName, 0);
end;
until FindNext(FoundItem) <> 0;
finally
FindClose(FoundItem);
end;
end;
procedure TFontsMap.LoadFonts();
var
FontIndex: Integer;
FontName: WideString;
FontsCount: LongInt;
begin
for FontIndex := 0 to Count - 1 do
begin
FontName := Keys[FontIndex];
FontsCount := AddFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
Data[FontIndex] := FontsCount;
end;
end;
procedure TFontsMap.UnloadFonts();
var
FontIndex: Integer;
FontName: WideString;
begin
for FontIndex := 0 to Count - 1 do
if Data[FontIndex] <> 0 then
begin
FontName := Keys[FontIndex];
RemoveFontResourceExW(PWideChar(FontName), FR_PRIVATE, nil);
end;
end;
constructor TFonts.Create();
begin
FFonts := TFontsMap.Create();
end;
destructor TFonts.Destroy();
begin
FFonts.Free();
inherited Destroy();
end;
procedure TFonts.Load(const APath: String);
begin
FFonts.ListFonts(APath);
FFonts.LoadFonts();
end;
procedure TFonts.Unload();
begin
FFonts.UnloadFonts();
end;
end.
Unfortunately, there are no imports of used functions (also constants), so you have to declare them yourself:
uses
Windows;
const
FR_PRIVATE = $00000010;
FR_NOT_ENUM = $00000020;
function AddFontResourceExW(name: LPCWSTR; fl: DWORD; res: PVOID): LongInt; stdcall external 'gdi32.dll';
function RemoveFontResourceExW(name: LPCWSTR; fl: DWORD; pdv: PVOID): BOOL; stdcall external 'gdi32.dll';
I don't know the cross-platform solution — the
{$IFDEF}s are required probably.