paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-15 14:39:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazReport: Fix the slow filling of font's combobox so it can now be made on designer opening, this fixes no showing the font in the font list when some object is selected and the report is just loaded.

Browse Source 
git-svn-id: trunk@63937 -
This commit is contained in:
jesus 2020-09-29 03:55:35 +00:00
parent b6c3d95216
commit ac50e66e44
1 changed files with 62 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
components/lazreport/source/lr_desgn.pas
View File

@ -3313,8 +3313,7 @@ var
begin begin
s := StrPas(LogFont.elfLogFont.lfFaceName); s := StrPas(LogFont.elfLogFont.lfFaceName);
Lst := TStrings(PtrInt(Data)); Lst := TStrings(PtrInt(Data));
if Lst.IndexOf(S)<0 then Lst.AddObject(S, TObject(PtrInt(FontType)));
Lst.AddObject(S, TObject(PtrInt(FontType)));
Result := 1; Result := 1;
end; end;
@ -3372,64 +3371,73 @@ procedure TfrDesignerForm.GetFontList;
var var
DC: HDC; DC: HDC;
Lf: TLogFont; Lf: TLogFont;
SysList: TStringList;
{$IFDEF USE_PRINTER_FONTS} {$IFDEF USE_PRINTER_FONTS}
Lst: TStrings; PrnList: TStringList;
i: Integer; i: Integer;
j: PtrInt; j: PtrInt;
{$ENDIF} {$ENDIF}
begin begin
C2.Items.Clear; SysList := TStringList.Create;
DC := GetDC(0); SysList.Duplicates := dupIgnore;
SysList.Sorted := true;
try try
Lf.lfFaceName := ''; DC := GetDC(0);
Lf.lfCharSet := DEFAULT_CHARSET;
Lf.lfPitchAndFamily := 0;
EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, PtrInt(C2.Items), 0);
finally
ReleaseDC(0, DC);
end;
{$IFDEF USE_PRINTER_FONTS}
if not CurReport.PrintToDefault then
begin
// we could use prn.Printer.Fonts but we would be tied to
// implementation detail of list.objects[] encoded with fonttype
// that's why we collect the fonts ourselves here
//
Lst := TStringList.Create;
try try
EnumFontFamiliesEx(Prn.Printer.Canvas.Handle, @Lf, @EnumFontsProc, PtrInt(Lst), 0); Lf.lfFaceName := '';
for i:=0 to Lst.Count-1 do Lf.lfCharSet := DEFAULT_CHARSET;
if C2.Items.IndexOf(Lst[i])<0 then begin Lf.lfPitchAndFamily := 0;
j := PtrInt(Lst.Objects[i]) or $100; EnumFontFamiliesEx(DC, @Lf, @EnumFontsProc, PtrInt(SysList), 0);
C2.Items.AddObject(Lst[i], TObject(j));
end;
finally finally
Lst.free; ReleaseDC(0, DC);
end; end;
end; {$IFDEF USE_PRINTER_FONTS}
{$ENDIF} if not CurReport.PrintToDefault then
begin
if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then PrnList := TStringList.Create;
begin PrnList.Duplicates := dupIgnore;
// font of selected memo has preference, select it PrnList.Sorted := true;
LastFontname := TfrCustomMemoView(FirstSelected).Font.Name; try
LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size; // we could use prn.Printer.Fonts but we would be tied to
end else // implementation detail of list.objects[] encoded with fonttype
if C2.Items.IndexOf(LastFontName)>=0 then // that's why we collect the fonts ourselves here
// last font name remains valid, keep it together with lastFontSize //
else begin EnumFontFamiliesEx(Prn.Printer.Canvas.Handle, @Lf, @EnumFontsProc, PtrInt(PrnList), 0);
// setup an initial font name and size for i:=0 to PrnList.Count-1 do
if C2.Items.Count>0 then if SysList.IndexOf(PrnList[i])<0 then begin
LastFontName := C2.Items[0] j := PtrInt(PrnList.Objects[i]) or $100;
else SysList.AddObject(PrnList[i], TObject(PtrInt(j)));
LastFontName := ''; end;
if C2.Items.IndexOf('Arial') <> -1 then finally
LastFontName := 'Arial' PrnList.Free;
else if C2.Items.IndexOf('helvetica [urw]')<>-1 then end;
LastFontName := 'helvetica [urw]' end;
else if C2.Items.IndexOf('Arial Cyr') <> -1 then {$ENDIF}
LastFontName := 'Arial Cyr'; if (SelNum>0) and (FirstSelected is TfrCustomMemoView) then
LastFontSize := 10; begin
// font of selected memo has preference, select it
LastFontname := TfrCustomMemoView(FirstSelected).Font.Name;
LastFontSize := TfrCustomMemoView(FirstSelected).Font.Size;
end else
if SysList.IndexOf(LastFontName)>=0 then
// last font name remains valid, keep it together with lastFontSize
else begin
// setup an initial font name and size
if SysList.Count>0 then
LastFontName := SysList[0]
else
LastFontName := '';
if SysList.IndexOf('Arial') <> -1 then
LastFontName := 'Arial'
else if SysList.IndexOf('helvetica [urw]')<>-1 then
LastFontName := 'helvetica [urw]'
else if SysList.IndexOf('Arial Cyr') <> -1 then
LastFontName := 'Arial Cyr';
LastFontSize := 10;
end;
finally
C2.Items.Assign(SysList);
SysList.Free;
end; end;
end; end;
@ -3972,8 +3980,9 @@ begin
Busy := True; Busy := True;
DocMode := dmDesigning; DocMode := dmDesigning;
//if C2.Items.Count=0 then if C2.Items.Count=0 then
// GetFontList; // defered to speed loading GetFontList;
LastFontSize := 10; LastFontSize := 10;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
LastFontName := 'Arial'; LastFontName := 'Arial';