Link to home
Start Free TrialLog in
Avatar of CodedK
CodedKFlag for Greece

asked on

Enumerate / List all available fonts

Hi.

I need to enumerate / List all the fonts available in the system filtered by the script.
For example :
List all fonts with Script type : Symbol
List all fonts with Script type : Greek

Thanks in advance :)
ASKER CERTIFIED SOLUTION
Avatar of mokule
mokule
Flag of Poland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I have a solution for you
You will still have to adapt this solution slightly to your needs
Before I explain any further, try it out - this will list only fonts in GREEK characterset:

This solution uses a listbox called "Listbox1"
and a button called "sbut_GetFixFonts"

== STEP 1 ==
== Add the following function to your unit: ==
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
if ((FontType and TrueType_FontType) <> 0) and
    ((LogFont.lfPitchAndFamily and VARIABLE_PITCH) = 0) then
  begin
  if Form1.ListBox1.Items.IndexOf(LogFont.lfFaceName) < 0 then
    Form1.ListBox1.Items.Add(LogFont.lfFaceName);
  end;
Result := 1;
end;

== Step 2 ==
== This is the button's event handler ==
== Note the line "LogFont.lfCharset := GREEK_CHARSET;" ==
== This procedure only lists fonts of GREEK characterset

procedure TForm1.sbut_GetFixFontsClick(Sender: TObject);
var
sDC: Integer;
LogFont: TLogFont;
begin
ListBox1.Items.Clear;
sDC := GetDC(0);
try
  ZeroMemory(@LogFont, sizeof(LogFont));
  LogFont.lfCharset := GREEK_CHARSET;
  EnumFontFamiliesEx(sDC, LogFont, @EnumFontsProc, 0, 0);
  finally
  ReleaseDC(0, sDC);
  end;
if ListBox1.Items.Count < 1 then
  ShowMessage('ERROR - No fonts of that type available');
end;
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of CodedK

ASKER

Thank you all for your input. Sorry for not posting earlier :/
I've tested your codes but this is not working for me :(

If you open WordPad and go to Format--> Font.
Select "Courier New".
And check the script you will see that it supports : GreeK, Western, Hebrew, Arabic, Turkish, Baltic, Central European, Cyrillic, Vietnamese.
This info is probably stored somewhere in the fonts, i want to extract this info and scan if it supports Greek or whatever.

The results from the sources above do not match the real results in my system at all.