Is there a cross-platform way to get a list of all monospaced fonts?

[Bart]

Hi,

I want to have a list (TStrings) of all monospaced fonts (their names) on the system.
I know how to get a list of all fonts, but I only want to show monospaced ones.

Reason: I want the user of my editor to be able to select a fontname, but the font must be monospaced (the editor is based upon synedit).

I could not find anything on the forum or wiki.

Bart

[Blaazen]

I only quickly found that Font has read-only property IsMonospaced. Maybe you assign all fonts in the list and remove all "not IsMonospaced". I hope that it will not be very slow.

[Bart]

IsMonoSpace seems to be only implemented for GTK/GTK2 and QT Interface 

Bart

[jmpessoa]

"...I know how to get a list of all fonts..."

Hi Bart,

I need  know how to get a list of all fonts!

Can you help me?

Thanks in advance!

[theo]

Hava a look at

<lazarusdir>/examples/fontenum/

[Bart]

This is very rude, but it kind of works (on Windows at least).
It fille a combobox with the names of all monospaced fonts.

Code: [Select]

procedure TForm1.Button1Click(Sender: TObject);
var
  SL: TStringList;
  i: Integer;
  W1, W2: Integer;
  lbl: TLabel;
  Tm, Tm0, Tm1: TDateTime;
  HH,MM,SS,MS: word;
begin
  lbl := tlabel.create(self);
  SL := TStringList.Create;
  try
    lbl.Parent := self;
    lbl.Visible := false;
    Tm := Now;
    repeat until Now <> Tm;
    Tm0 := Now;
    for i := 0 to Screen.Fonts.Count - 1 do
    begin
      lbl.Font.Name := Screen.Fonts.Strings[i];
      if lbl.Font.IsMonoSpace then SL.Add(Font.Name) else
      begin
        W1 := lbl.Canvas.TextWidth('WMWMWM');
        W2 := lbl.Canvas.TextWidth('iiiiii');
        //writeln(lbl.Font.Name,': W1 = ',w1,' W2 = ',w2);
        if (W1 = W2) then SL.Add(lbl.Font.Name);
      end;
    end;
    Tm1 := Now;
    DecodeTime(Tm0-Tm1,HH,MM,SS,Ms);
    Ms := (1000*SS) + Ms;
    writeln(Screen.Fonts.Count,' fonts: ',Ms,' Ms');
    ComboBox1.Items.Assign(Sl);
    if ComboBox1.Items.Count > 0 then ComboBox1.ItemIndex := 0;
  finally
    SL.free;
    lbl.free;
  end;
end;

Takes 328 Msec on my system.

Bart

[jmpessoa]

Thank you very much Bart!

[jmpessoa]

"Hava a look at

<lazarusdir>/examples/fontenum/"

Thank you Theo!

[Bart]

Hi,

Attached demo fills 4 listboxes with

• All fonts
• Fixed Pitched fonts
• Mono Spaced fonts
• Fonts that have same TextWidth for 'WMWMWM' and 'iiiiii' so probaby fixed pitch or monospace

The last approach takes quit some time on Linux/GTK2 (> 15 sec. on my ancient 700 Mhz system), so be patient.

Notice the comments in the code about differences between Windows and Linux/GTK2.

It would be interesting if someone could test this for:

• QT (Win, Linux, MacOSX)
• Carbon
• Cocoa
• CustomDrawn
• fpGUI

Note: When you select (OK, actually change the selection in) one of the fonts of a listbox, the font of the memo will be set to it.

So, feedback asked!

Bart

[Blaazen]

I tested on openSuSE, KDE4 (Qt). It takes ~1 sec. on Core2Duo 2GHz.
1-st ListBox has 78 fonts
2-nd and 3-rd are empty
4-th (Brute) finds 24 monospaced fonts

[Bart]

Did you test wiht changing the code like for GTK (see comments in code)?

Bart

[Blaazen]

Oh, I did not read properly your previous post.

Now I tried (Qt and GTK (as GTK_appearance under KDE4) again and works.

The 2-nd and 3-rd are now filled (and both ListBoxes has the same content for both Qt and GTK2).

However, they are a little different. Qt finds 25 mono fonts and GTK2 26. Brute approach is also ±2 fonts different.
To be exact:
GTK2: 78, 26, 26, 23
Qt4: 78, 25, 25, 24
But in general it works well.

[Bart]

On my Suse GTK2 fixed pitched fonts are the same as mono-spaced fonts.
Brute force finds a little less, but seems to be correct since some of the fonts that pango returns as fixed pitch do not seem to be fixed pict in the memo at all.

My problem now, however, is that where the comments in my code say GTK needs FIXED_PITCH (or MONO_FONT),  MS states that this must be zero. So EnumFontamilesEX() currently works different on different platforms/widgetsets.

I asked a question about this on Lazarus-dev mailinglist, but got no reply yet.

Thanks for the testing.

Bart

[mercury]

@Bart
I tested your demo on my computer. (win32)
All fonts ： 274
Fixed Pitched fonts ： 41
Mono Spaced fonts ： 0
brute approach ： 51
Takes about 300~400ms. (Sometimes 400+ sometimes 300+, it's not fixed)

But, when running at a sandbox it get 53 fonts.
Two different fonts are:
ADMUI3Lg
ADMUI3Sm
I have no idea how this happened.

I'm wonder it there a fast way to get ALL monospace fonts.

Thank you very much.