Lazarus

Programming => LCL => Topic started by: AlexTP on October 16, 2020, 10:04:40 am

Title: Proposal. Font "default_mono"
Post by: AlexTP on October 16, 2020, 10:04:40 am

I suggest to introduce LCL font "default_mono"(we have "default" font only):

- on first access to getter/resolver, find some monospaced font:

a) if font list has "Consolas"/"Courier New"/"Courier", we take it (to support Win32 usual font)

b) if no usual names found (case for *BSD+Solaris+Wine) we enumerate font list, find some, by testing Canvas.TextWidth('W')=Canvas.TextWidth('i'). The problem here is - we don't have some Canvas in getter. Maybe use GetDC(0).

- on next access to getter, we return calculated name.

- I can find the avg time of this action (step b) on Linux/BSD/Solaris, if it's needed

Title: Re: Proposal. Font "default_mono"
Post by: olly on October 17, 2020, 11:52:59 pm

I've found step b ridiculously slow (15 seconds) using GTK2. There's a post about it somewhere on the forum too.

I switched to using the following. Works well on Windows and GTK-2.
I don't think it's implemented yet on cocoa though.

Code: Pascal  [Select][+][-]

1. function EnumFontsFixedPitchNoDups(var LogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx; FontType: LongInt; Data: LParam): LongInt; stdcall;
2. var
3.   S: String;
4. begin
5.   S := LogFont.elfLogFont.lfFaceName;
6.   if ((LogFont.elfLogFont.lfPitchAndFamily and FIXED_PITCH) = FIXED_PITCH) then
7.     TStringList(PtrUInt(Data)).Add(S);
8.  
9.   Result := 1;
10. end;
11.  
12. procedure PopulateFonts;
13. var
14.   DC: HDC;
15.   LogFont: TLogFont;
16. begin
17.   LogFont.lfCharSet := DEFAULT_CHARSET;
18.   LogFont.lfFaceName := '';
19.   LogFont.lfPitchAndFamily := {$IFDEF LINUX}FIXED_PITCH{$ELSE}0{$ENDIF};
20.  
21.   DC := GetDC(0);
22.  
23.   try
24.     EnumFontFamiliesEX(DC, @LogFont, @EnumFontsFixedPitchNoDups, PtrUInt(FFonts), 0);
25.   finally
26.     ReleaseDC(0, DC);
27.   end;
28. end;
29.