Recent

Author Topic: Finding a TFont by name [SOLVED]  (Read 8111 times)

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Finding a TFont by name [SOLVED]
« on: July 13, 2017, 02:50:00 pm »
Hello, is there a way of finding a TFont by supplying a font name, preferably one which doesn't have the overhead of lots of graphics related updates. My aim is to take the list of fonts available from Screen.Fonts; and filter it by characteristic, particularly whether it is Monospaced or not.
« Last Edit: July 15, 2017, 02:15:11 pm by carl_caulkett »
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Finding a TFont by name
« Reply #1 on: July 13, 2017, 05:51:35 pm »
One example would be to assign them to a generic array and write an enumerator/filter for TFont.Pitch. (fpFixed = monospace)
Specialize a type, not a var.

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #2 on: July 13, 2017, 06:13:49 pm »
Thanks. I'll investigate that next. I was experimenting with this code:

Code: Pascal  [Select][+][-]
  1. procedure TcaFontSelectorForm.DoShow;
  2. var
  3.   FontName: string;
  4.   AFont: TFont;
  5. begin
  6.   inherited DoShow;
  7.   FontList.Items.BeginUpdate;
  8.   try
  9.     FFontNames.Assign(Screen.Fonts);
  10. //    for FontName in FFontNames do
  11.     FontName := 'Courier New';
  12.       begin
  13.         AFont := TFont.Create;
  14.         try
  15.           AFont.Name := FontName;
  16.           if FontIsMonoSpace(HFONT(AFont.Reference.Handle)) then
  17.             FontList.Items.Add(FontName);
  18.         finally
  19.           AFont.Free;
  20.         end;
  21. //        if FontIsMonoSpace(CreateFont(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, PChar(FontName))) then
  22.       end;
  23.   finally
  24.     FontList.Items.EndUpdate;
  25.   end;
  26. end;
  27.  

But ultimately I ran into a hard coded non-implementation in intfbaselcl.inc which simply reads:

Code: Pascal  [Select][+][-]
  1. function TWidgetSet.FontIsMonoSpace(Font: HFont): boolean;
  2. begin
  3.   Result:=false;
  4. end;
  5.  

Hopefully, I'll have better luck with the Pitch property like Thaddy suggested. Back in a few minutes!
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #3 on: July 13, 2017, 08:40:28 pm »
The problem seems to be that the Screen.Fonts property only contains the list of names - it doesn't have the actual font objects in the Objects[] property.

This is one of the few occasions over the last couple of months where I've thought to myself that this would be easier under Windows!
« Last Edit: July 13, 2017, 08:46:49 pm by carl_caulkett »
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #4 on: July 13, 2017, 10:09:15 pm »
I found a promising looking project in the Lazarus examples called FontEnumeration, but when I ran it, it showed all 567 fonts on my machine but wasn't able to filter them when I selected FIXED_PITCH or MONO_PITCH from the Pitch combo and pressed "apply filter".

I've just tried setting the font of a displayed control to 'Courier New' and tried reading the Pitch and IsMonoSpace properties, and neither are set correctly. I'm forced to conclude that these properties are not supported with the current default widget set on the Apple Mac. That, in turn, has led me to discover another Lazarus feature, namely the Padlock icon on certain properties in the Ctrl-Space dropdown and the Restricted tab in the Object Inspector!

This probably explains why Lazarus does not attempt to limit the choice of editor fonts in the Options -> Editor -> Display dialog. I think I'm going to be forced to keep a list of all known Monospaced fonts and filter on the basis of that. Just the thought of doing that makes me feel dirty, somehow!
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #5 on: July 13, 2017, 11:32:47 pm »
I found a rather neat, yet pragmatic solution to the problem on StackOverflow. A fixed width font could be defined as one where the TextWidth of the characters is the same regardless of the character. Luckily, the Canvas.TextWidth property is available on the Apple Mac. The code now looks like this...

Code: Pascal  [Select][+][-]
  1. procedure TcaFontSelectorForm.DoShow;
  2. var
  3.   FontName: string;
  4. begin
  5.   inherited DoShow;
  6.   FontList.Items.BeginUpdate;
  7.   Cursor := crHourGlass;
  8.   Application.ProcessMessages;
  9.   try
  10.     FFontNames.Assign(Screen.Fonts);
  11.     for FontName in FFontNames do
  12.       begin
  13.         FontList.Canvas.Font.Name := FontName;
  14.         FontList.Canvas.Font.Size := 10;
  15.         if FontList.Canvas.TextWidth('m') = FontList.Canvas.TextWidth('i') then
  16.           FontList.Items.Add(FontName);
  17.       end;
  18.   finally
  19.     FontList.Items.EndUpdate;
  20.     Cursor := crDefault;
  21.   end;
  22. end;
  23.  

The processing of the fonts does give rise to a slight delay, which I have tried to handle with the showing of the cursor. However, the cursor doesn't appear immediately despite the Application.ProcessMessages; call. Can anyone tell me why that might be?

Thanks,
Carl
« Last Edit: July 13, 2017, 11:51:07 pm by carl_caulkett »
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Finding a TFont by name
« Reply #6 on: July 13, 2017, 11:56:53 pm »
Perhaps because of an unneccesary Assign.
Why would Application.ProcessMessages be needed?
Try this:
Code: Pascal  [Select][+][-]
  1. procedure TcaFontSelectorForm.DoShow;
  2. var
  3.   FontName: string;
  4. begin
  5.   inherited DoShow;
  6.   Cursor := crHourGlass;
  7.   FontList.Items.BeginUpdate;
  8.   try
  9.     for FontName in Screen.Fonts do
  10.     begin
  11.       FontList.Canvas.Font.Name:=FontName;
  12.       FontList.Canvas.Font.Size:=10;
  13.       if (FontList.Canvas.TextWidth('m') = FontList.Canvas.TextWidth('i')) then
  14.         FontList.Items.Add(FontName);
  15.     end;
  16.   finally
  17.     FontList.Items.EndUpdate;
  18.     Cursor := crDefault;
  19.   end;
  20. end;

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #7 on: July 14, 2017, 12:45:16 am »
You're right! Screen.Fonts is already populated after all. Why would I need to populate a second list? Well spotted, and thanks - it's a whole lot faster now.
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

wp

  • Hero Member
  • *****
  • Posts: 11858
Re: Finding a TFont by name
« Reply #8 on: July 14, 2017, 01:09:20 am »
As an alternative you may want to look at how TScreen collects the font names (needs Lclintf):
Code: Pascal  [Select][+][-]
  1. procedure GetScreenFontsList(FontList: TStrings);
  2. var
  3.   lf: TLogFont;
  4.   DC: HDC;
  5. begin
  6.   lf.lfCharSet := DEFAULT_CHARSET;
  7.   lf.lfFaceName := '';
  8.   lf.lfPitchAndFamily := 0;
  9.   DC := GetDC(0);
  10.   try
  11.     EnumFontFamiliesEx(DC, @lf, @EnumFontsNoDups, PtrInt(FontList), 0);
  12.   finally
  13.     ReleaseDC(0, DC);
  14.   end;
  15. end;
EnumFontFamiliesEx needs a callback function, here EnumFontsNoDups:

Code: Pascal  [Select][+][-]
  1. function EnumFontsNoDups(var LogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
  2.   FontType: Longint; Data: LParam): LongInt; extdecl;
  3. var
  4.   L: TStrings;
  5.   S: String;
  6. begin
  7.   L := TStrings(PtrInt(Data));
  8.   S := LogFont.elfLogFont.lfFaceName;
  9.   if L.IndexOf(S) < 0 then
  10.     L.Add(S);
  11.   Result := 1;
  12. end;
Knowing that the record TLogFont has a field lfPitchAndFamily you certainly can extend this to collect only the fixed-pitch fonts. It is a good exercise navigating through the Lazarus code.

You may also want to look at the project fontenumeration in the folger examples/fontenum of the lazarus installation. It makes uses of this technique.

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #9 on: July 14, 2017, 01:23:01 am »
I tried out the fontenumeration project earlier. Changing the Pitch select combos didn't make any difference to the filtering of fonts. Whatever I selected, all 567 fonts on my computer (Apple Mac with Carbon widget set) were displayed.
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

wp

  • Hero Member
  • *****
  • Posts: 11858
Re: Finding a TFont by name
« Reply #10 on: July 14, 2017, 09:37:00 am »
You are giving up too early. The fact that the demo is not working like you want does not mean that the idea is wrong, the demo contains all the information you need to solve this - if you would look at the code and would try to understand it.
« Last Edit: July 14, 2017, 10:49:16 am by wp »

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #11 on: July 14, 2017, 10:25:40 am »
I tried out the fontenumeration project earlier. Changing the Pitch select combos didn't make any difference to the filtering of fonts. Whatever I selected, all 567 fonts on my computer (Apple Mac with Carbon widget set) were displayed.

That message was written at 01:23 am. I was *not* giving up too early. In fact, I was already making mistakes due to tiredness. So, I went to bed. Now, in the morning, having reviewed the TScreen code, I feel confident of being up to the task of understanding it.
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Finding a TFont by name
« Reply #12 on: July 14, 2017, 10:28:06 am »
 :D
Specialize a type, not a var.

wp

  • Hero Member
  • *****
  • Posts: 11858
Re: Finding a TFont by name
« Reply #13 on: July 14, 2017, 10:35:09 am »
I was *not* giving up too early.
You know better, of course, I just had the impression. Excuse my harsh words, but sometimes I get the feeling that people want an finished "cookbook" solution here instead of using their own brain.

carl_caulkett

  • Sr. Member
  • ****
  • Posts: 306
Re: Finding a TFont by name
« Reply #14 on: July 14, 2017, 12:45:18 pm »
I tried your FilterFonts project.

I had to change the line lf.lfCharSet := ANSI_CHARSET; to lf.lfCharSet := DEFAULT_CHARSET; otherwise the function TCarbonWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont; Callback: FontEnumExProc; LParam: Lparam; flags: dword): Longint; just bombed out with the message TCarbonWidgetSet.EnumFontFamiliesEx with specific face or char set is not implemented!.

Once I got that working, I was only able to see fonts listed in the listbox when no filters were selected. This, I think, is because the LogFont.elfLogFont.lfPitchAndFamily is not being populated properly. I tweaked the callback function to check:

Code: Pascal  [Select][+][-]
  1. function EnumFontsPitch(
  2.   var LogFont: TEnumLogFontEx;
  3.   var Metric: TNewTextMetricEx;
  4.   FontType: Longint;
  5.   Data: LParam):LongInt; stdcall;
  6. var
  7.   L: TStringList;
  8.   S: String;
  9. begin
  10.   L := TStringList(ptrint(Data));
  11.   S := LogFont.elfLogFont.lfFaceName;
  12.   if S = 'Courier New' then
  13.     begin
  14.       if (L.IndexOf(S) < 0) and (LogFont.elfLogFont.lfPitchAndFamily AND FILTER = FILTER) then // BREAKPOINT SET HERE
  15.         L.Add(S);
  16.       result := 1;
  17.     end;
  18. end;
  19.  

LogFont.elfLogFont.lfPitchAndFamily has a byte value of \0 according to LLDB which, if FILTER is anything other than 0, means that L.Add(S) is not called.

Unless I'm missing something, it does look like Pitch is not supported by the Carbon widget set on the Apple Mac.
"It builds... ship it!"

Mac Mini M1
macOS 13.6 Ventura
Lazarus 2.2.6 (release version)
FPC 3.2.2 (release version)

 

TinyPortal © 2005-2018