Getting System Fonts List in Firemonkey : TPlatformExtensions class

In stack-overflow forum which I make use of very much, someone asked this question. How can we get the list of installed fonts in Firemonkey as we have in VC TScreen.Fonts? For Firemonkey these kinds of questions mostly is a deal with cross-platform compatibility, so any kind of actions that is called directly for the core system should be done twice, one for Windows the other for OSX. However I strongly suggest to my readers and new programmers that always they should keep platform dependant code in separate units, ans use an abstract layer to combine them. A good example for this is the new TPlatformExtensions class which I have recently started. The first utility function of the class is GetSystemFonts which is a solution for the question in stack-overflow and for others who will need the list of the available fonts. This class will be an abstract class defined in FMX.PlatformExtensions.Pas and a Windows and OSX versions will be implemented in FMX.PlatformExtensions.Win.pas and FMX.PlatformExtensions.Mac.pas units separately.

So in this blog, I have a chance to show you both a specific and a general case together: Getting the list of the fonts in Firemonkey, and handling this cross-platform related issue in a reusable patterned way.

TPlatformExtensions Class

Firemonkey has a got a TPlatform class which is a port to platform related issues. But of course it doesn’t handle all the things that were handled in VCL. This all because of time and the double man-power that should be used in the implementation. However enough know-how is also in the web to handle any platform related issue  so you can easily solve these kind of problems. I decided to collect all my platform dependant solutions in one class which I called TPlatformExtensions. For now, it has got only one utility function, but each time I design a platform related solution in this blog I will add it to this class. Here is the class:

TPlatformExtensions = class(TObject)
 public
 Class Procedure GetSystemFonts(FontList:TStringlist);virtual;abstract;
 end;

This class is an abstract class ( means will have abstract methods to be overridden) and only the inherited platform classes will be created in runtime. But users will call the platform functions using this class. Son in the same unit there vill be a variable definition for users to use.

var
 PlatformExtensions:TPlatformExtensions;

This is like using Printer object, which is behaves like a singleton of TPrinter class. So in the initialization block, this object will be created automatically according to the platform and will be freed when the unit is finalized.

initialization
  {$IFDEF MACOS}
    PlatformExtensions := TPlatformExtensionsMac.Create;
   {$ENDIF}
   {$IFDEF MSWINDOWS}
     PlatformExtensions := TPlatformExtensionsWin.Create;
   {$ENDIF}
finalization
  PlatformExtensions.Free;

Note that we have two other class names here, one of the is for Mac and the other is for Win. They can be reached in their units which is referenced in a uses clause after implementation to get rid of circular references.

uses
 {$IFDEF MACOS}
 FMX.PlatformExtensions.Mac;
 {$ENDIF}
 {$IFDEF MSWINDOWS}
 FMX.PlatformExtensions.Win;
 {$ENDIF}

So in its simplest form, just add the FMX.PlatformExtensions in your own uses clause and use PlatfromExtensions objects.

Here are the two PlatformExtensions class definitions for Win and Mac.

Declared in PlatformExtensions.Win.Pas

 TPlatformExtensionsWin = class(TPlatformExtensions)
 public
   Class Procedure GetSystemFonts(FontList:TStringlist);override;
 end;

Declared in PlatformExtensions.Mac.Pas

 TPlatformExtensionsMac = class(TPlatformExtensions)
 public
   Class Procedure GetSystemFonts(FontList:TStringlist);override;
 end;

Coding the first procedure: GetSystemFonts

In OSX, the fonts list can be reached using the  sharedFontManager object of NSFontManager. It will return the font list as a NSString array. So you should first wrap a NSFontmanager object, then call the availableFontFamilies selector. The result is an NSArray which you can go through its list and get each family name as NSString. Note that an NSString is not a Delphi string, so you should convert it in someway. A cheap and practical way is to use the UTF8 characters which Delphi directly can cast to String type. For example;

MyDelphiString := String(MyNsString.UTF8String);

So here is the procedure code for GetSystemFonts in Mac platform:

class procedure TPlatformExtensionsMac.GetSystemFonts(FontList: TStringlist);
var
  fManager: NsFontManager;
  list:NSArray;
  lItem:NSString;
  i: Integer;
begin
  fManager := TNsFontManager.Wrap(TNsFontManager.OCClass.sharedFontManager);
  list := fManager.availableFontFamilies;
  if (List <> nil) and (List.count > 0) then
  begin
    for i := 0 to List.Count-1 do
    begin
      lItem := TNSString.Wrap(List.objectAtIndex(i));
      FontList.Add(String(lItem.UTF8String));
    end;
  end;
end;

Windows SDK coding is a little bit more complicated as it has been before. To be able to get the system fonts one should use the EnumFontFamiliesEx api function which uses a callback function to enumerate each font family in the system. I have been inspired by the TScreen.GetFonts in VCL code, and here it is:

function EnumFontsList(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
var
  List: TStrings;
  fName: string;
begin
  List := TStrings(Data);
  fName := LogFont.lfFaceName;
  if (List.Count = 0) or (AnsiCompareText(List[List.Count-1], fName) <> 0) then
    List.Add(fName);
  Result := 1;
end;

class procedure TPlatformExtensionsWin.GetSystemFonts(FontList: TStringlist);
var
  dContext: HDC;
  LFont: TLogFont;
begin
  dContext := GetDC(0);
  FillChar(LFont, sizeof(LFont), 0);
  LFont.lfCharset := DEFAULT_CHARSET;
  EnumFontFamiliesEx(dContext, LFont, @EnumFontsList, Winapi.Windows.LPARAM(FontList), 0);
  ReleaseDC(0, dContext);
end;

You can get the source code of the PlatformExtensions classes with the demo application from this SVN link. For non-programmers the compiled Win32, Win64, MacOSX (Thanks to Firemonkey) applications are also available to download.