?
Solved

Enumerate / List all available fonts

Posted on 2007-10-07
4
Medium Priority
?
715 Views
Last Modified: 2008-01-09
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 :)
0
Comment
Question by:CodedK
  • 2
4 Comments
 
LVL 17

Accepted Solution

by:
mokule earned 1200 total points
ID: 20029979
I've got following code

var
  Form1: TForm1;
  lb: TListBox;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  lb.Items.Add(LogFont.lfFaceName);
  Result := 1;
end;

//------------------------------------------------------------------------------
procedure TForm1.Changed;
var
  dc: HDC;
  lf: TLogFont;
begin
  ListBox2.Clear;
  ZeroMemory(@lf,sizeof(lf));
  lf.lfCharSet := GREEK_CHARSET;
  dc := GetDC(0);
  lb := ListBox2;
  EnumFontFamiliesEx(dc,lf,@EnumFontsProc,0,0);
  ReleaseDC(0,dc);
end;
0
 
LVL 13

Expert Comment

by:rfwoolf
ID: 20029987
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;
0
 
LVL 13

Assisted Solution

by:rfwoolf
rfwoolf earned 800 total points
ID: 20030000
Now instead of saying
"  LogFont.lfCharset := GREEK_CHARSET;"
you will want to change "GREEK_CHARSET" to the charset you want to filter by, e.g.
lfCharSet
Specifies the character set. The following values are predefined.
ANSI_CHARSET
BALTIC_CHARSET
CHINESEBIG5_CHARSET
DEFAULT_CHARSET
EASTEUROPE_CHARSET
GB2312_CHARSET
GREEK_CHARSET
HANGUL_CHARSET
MAC_CHARSET
OEM_CHARSET
RUSSIAN_CHARSET
SHIFTJIS_CHARSET
SYMBOL_CHARSET
TURKISH_CHARSET
VIETNAMESE_CHARSET

Korean language edition of Windows:
JOHAB_CHARSET
Middle East language edition of Windows:
ARABIC_CHARSET
HEBREW_CHARSET
Thai language edition of Windows:
THAI_CHARSET

You can put those CHARSETS in a string variable.
The user will select a charset from a combobox, and on that line you will say
LogFont.lfCharset := Combobox1.text;
0
 
LVL 16

Author Comment

by:CodedK
ID: 20253500
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.
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
This video shows how to quickly and easily deploy an email signature for all users in Office 365 and prevent it from being added to replies and forwards. (the resulting signature is applied on the server level in Exchange Online) The email signat…
When cloud platforms entered the scene, users and companies jumped on board to take advantage of the many benefits, like the ability to work and connect with company information from various locations. What many didn't foresee was the increased risk…
Suggested Courses

750 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question