paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 10:18:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Optimize getting a list of font names and eliminating duplicates in TScreen.

Browse Source
This commit is contained in:
Juha 2024-02-06 11:04:43 +02:00
parent 998b38112f
commit db95c28df7
2 changed files with 27 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/forms.pp
View File

@ -1133,7 +1133,7 @@ type
FDefaultCursor: HCURSOR;
FHintFont: TFont;
FFocusedForm: TCustomForm;
FFonts : TStrings;
FFonts : TStringList;
FFormList: TFPList;
FDataModuleList: TFPList;
FIconFont: TFont;

49
lcl/include/screen.inc
View File

@ -36,13 +36,19 @@ end;
function EnumFontsNoDups(var LogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx;
FontType: Longint; Data: LParam): LongInt; extdecl;
var
L: TStrings;
L: TStringList;
S: String;
begin
L := TStrings(Data);
L := TStringList(Data);
Assert(not L.Sorted, 'EnumFontsNoDups: List of fonts has Sorted=True.');
Assert(not L.UseLocale, 'EnumFontsNoDups: List of fonts has UseLocale=True.');
S := LogFont.elfLogFont.lfFaceName;
if L.IndexOf(S) < 0 then
// Prevent consecutive duplicates. The list is alphabetically sorted in all platforms.
if (L.Count=0) or (L[L.Count-1] <> S) then begin
// There should be no duplicates elsewhere in the list.
Assert(L.IndexOf(S)<0,'EnumFontsNoDups: Unexpected duplicate font "'+S+'"');
L.Add(S);
end;
Result := 1;
end;
@ -61,10 +67,11 @@ end;
constructor TScreen.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
FFonts := TStringListUTF8Fast.Create;
FFonts := TStringList.Create; // FFonts will be sorted in GetFonts.
FFonts.UseLocale := False;
//FFonts.CaseSensitive := True;
FCursorMap := TMap.Create(its4, SizeOf(HCursor));
FMonitors := TMonitorList.Create;
//TStringlist(FFonts).Sorted := True; Will be sorted in GetFonts
FCustomForms := TFPList.Create;
FCustomFormsZOrdered := TFPList.Create;
FFormList := TFPList.Create;
@ -588,31 +595,27 @@ begin
Result := UpdatedMonitor(MonitorHandle, MonitorDefault, 'TScreen.MonitorFromWindow');
end;
procedure GetScreenFontsList(FontList: TStrings);
var
lf: TLogFont;
DC: HDC;
begin
lf.lfCharSet := DEFAULT_CHARSET;
lf.lfFaceName := '';
lf.lfPitchAndFamily := 0;
DC := GetDC(0);
try
EnumFontFamiliesEx(DC, @lf, @EnumFontsNoDups, PtrInt(FontList), 0);
finally
ReleaseDC(0, DC);
end;
end;
{------------------------------------------------------------------------------
function TScreen.GetFonts : TStrings;
------------------------------------------------------------------------------}
function TScreen.GetFonts : TStrings;
var
lf: TLogFont;
DC: HDC;
begin
if FFonts.Count = 0 then
begin
GetScreenFontsList(FFonts);
TStringList(FFonts).Sort;
lf.lfCharSet := DEFAULT_CHARSET;
lf.lfFaceName := '';
lf.lfPitchAndFamily := 0;
DC := GetDC(0);
try
EnumFontFamiliesEx(DC, @lf, @EnumFontsNoDups, PtrInt(FFonts), 0);
finally
ReleaseDC(0, DC);
end;
// Widgetset already provided a sorted list, but this enables fast binary search.
FFonts.Sorted:=True;
end;
Result := FFonts;
end;