paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 14:27:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug #0036581, amended patch by Pascal Riekenberg

Browse Source 
git-svn-id: trunk@43973 -
This commit is contained in:
michael 2020-01-18 16:40:57 +00:00
parent 0c2400e856
commit 6984cf8606
27 changed files with 447 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
.gitattributes vendored
View File

@ -3859,6 +3859,11 @@ packages/fcl-report/demos/countries2.inc svneol=native#text/plain
packages/fcl-report/demos/demos.inc svneol=native#text/plain
packages/fcl-report/demos/fcldemo.lpi svneol=native#text/plain
packages/fcl-report/demos/fcldemo.pp svneol=native#text/plain
packages/fcl-report/demos/fonts/DejaVuSans-Bold.ttf -text
packages/fcl-report/demos/fonts/DejaVuSans-BoldOblique.ttf -text
packages/fcl-report/demos/fonts/DejaVuSans-ExtraLight.ttf -text
packages/fcl-report/demos/fonts/DejaVuSans-Oblique.ttf -text
packages/fcl-report/demos/fonts/DejaVuSans.ttf -text
packages/fcl-report/demos/fonts/LiberationSans-Bold.ttf -text
packages/fcl-report/demos/fonts/LiberationSans-BoldItalic.ttf -text
packages/fcl-report/demos/fonts/LiberationSans-Italic.ttf -text
@ -3867,6 +3872,16 @@ packages/fcl-report/demos/fonts/LiberationSerif-Bold.ttf -text
packages/fcl-report/demos/fonts/LiberationSerif-BoldItalic.ttf -text
packages/fcl-report/demos/fonts/LiberationSerif-Italic.ttf -text
packages/fcl-report/demos/fonts/LiberationSerif-Regular.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-B.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-BI.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-C.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-L.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-LI.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-M.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-MI.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-R.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-RI.ttf -text
packages/fcl-report/demos/fonts/Ubuntu-Th.ttf -text
packages/fcl-report/demos/laz2fpreport.lpi svneol=native#text/plain
packages/fcl-report/demos/laz2fpreport.pp svneol=native#text/plain
packages/fcl-report/demos/pictures/man01.png -text svneol=unset#image/png
@ -3935,6 +3950,7 @@ packages/fcl-report/src/fpreportjson.pp svneol=native#text/plain
packages/fcl-report/src/fpreportpdfexport.pp svneol=native#text/plain
packages/fcl-report/src/fpreportqrcode.pp svneol=native#text/plain
packages/fcl-report/src/fpreportstreamer.pp svneol=native#text/plain
packages/fcl-report/test/README.md svneol=native#text/plain
packages/fcl-report/test/fonts/LiberationSerif-Regular.ttf -text
packages/fcl-report/test/fonts/calibri.ttf -text
packages/fcl-report/test/fonts/calibrib.ttf -text
@ -3946,6 +3962,7 @@ packages/fcl-report/test/regtests.pp svneol=native#text/plain
packages/fcl-report/test/tcbasereport.pp svneol=native#text/plain
packages/fcl-report/test/tchtmlparser.pas svneol=native#text/plain
packages/fcl-report/test/tcreportdom.pp svneol=native#text/plain
packages/fcl-report/test/tcreportgenerator.pas svneol=native#text/plain
packages/fcl-report/test/tcreportstreamer.pp svneol=native#text/plain
packages/fcl-report/test/testfpreport.lpi svneol=native#text/plain
packages/fcl-report/test/testfpreport.lpr svneol=native#text/plain

BIN
packages/fcl-report/demos/fonts/DejaVuSans-Bold.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/DejaVuSans-BoldOblique.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/DejaVuSans-ExtraLight.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/DejaVuSans-Oblique.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/DejaVuSans.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-B.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-BI.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-C.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-L.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-LI.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-M.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-MI.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-R.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-RI.ttf Normal file
View File

Binary file not shown.

BIN
packages/fcl-report/demos/fonts/Ubuntu-Th.ttf Normal file
View File

Binary file not shown.

4
packages/fcl-report/demos/rptexpressions.pp
View File

@ -135,7 +135,11 @@ begin
Memo.Layout.Top := 20;
Memo.Layout.Width := 50;
Memo.Layout.Height := 8;
{$IFDEF fptestX}
Memo.Text := 'Report Date: 2020-01-15';
{$ELSE}
Memo.Text := 'Report Date: [TODAY]';
{$ENDIF}
Memo := TFPReportMemo.Create(TitleBand);
Memo.Layout.Left := 0;

25
packages/fcl-report/demos/rptgrouping.pp
View File

@ -154,7 +154,7 @@ begin
{*** group header ***}
GroupHeader := TFPReportGroupHeaderBand.Create(p);
GroupHeader.Layout.Height := 15;
GroupHeader.GroupCondition := 'copy(country,1,1)';
GroupHeader.GroupCondition := 'copy(data.country,1,1)';
{$ifdef ColorBands}
GroupHeader.Frame.Shape := fsRectangle;
GroupHeader.Frame.BackgroundColor := clGroupHeaderFooter;
@ -166,7 +166,7 @@ begin
Memo.Layout.Width := 10;
Memo.Layout.Height := 8;
Memo.UseParentFont := False;
Memo.Text := '[copy(country,1,1)]';
Memo.Text := '[copy(data.country,1,1)]';
Memo.Font.Size := 16;
Memo := TFPReportMemo.Create(GroupHeader);
@ -197,11 +197,11 @@ begin
{*** variables ***}
rpt.Variables.AddExprVariable('population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat, rtNone, '');
rpt.Variables.AddExprVariable('grp_sum_population', 'sum(StrToFloat(population))',rtFloat , GroupHeader);
rpt.Variables.AddExprVariable('grp_sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat, GroupHeader);
rpt.Variables.AddExprVariable('sum_population', 'sum(StrToFloat(population))', rtFloat, rtnone, '');
rpt.Variables.AddExprVariable('sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat,rtnone,'');
rpt.Variables.AddExprVariable('population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat, rtNone, '');
rpt.Variables.AddExprVariable('grp_sum_population', 'sum(StrToFloat(data.population))',rtFloat , GroupHeader);
rpt.Variables.AddExprVariable('grp_sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat, GroupHeader);
rpt.Variables.AddExprVariable('sum_population', 'sum(StrToFloat(data.population))', rtFloat, rtnone, '');
rpt.Variables.AddExprVariable('sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat,rtnone,'');
{*** detail ***}
@ -218,7 +218,7 @@ begin
Memo.Layout.Top := 2;
Memo.Layout.Width := 45;
Memo.Layout.Height := 5;
Memo.Text := '[country]';
Memo.Text := '[data.country]';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 55;
@ -237,7 +237,7 @@ begin
Memo.Text := '> Germany';
Memo.UseParentFont := false;
Memo.Font.Color := clGreen;
Memo.VisibleExpr := 'StrToFloat(population) > 80890000';
Memo.VisibleExpr := 'StrToFloat(data.population) > 80890000';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 85;
@ -247,7 +247,7 @@ begin
Memo.Text := '< Germany';
Memo.UseParentFont := false;
Memo.Font.Color := clRed;
Memo.VisibleExpr := 'StrToFloat(population) < 80890000';
Memo.VisibleExpr := 'StrToFloat(data.population) < 80890000';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 110;
@ -255,7 +255,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/grp_sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/grp_sum_population*100)] %';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 130;
@ -263,7 +263,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/sum_population*100)] %';
{*** group footer ***}
GroupFooter := TFPReportGroupFooterBand.Create(p);
@ -353,6 +353,7 @@ constructor TGroupingDemo.Create(AOwner: TComponent);
begin
inherited;
lReportData := TFPReportUserData.Create(nil);
lReportData.Name := 'data';
lReportData.OnGetValue := @GetReportDataValue;
lReportData.OnGetEOF := @GetReportDataEOF;
lReportData.OnFirst := @GetReportDataFirst;

63
packages/fcl-report/demos/rptnestedgroups.pp
View File

@ -192,7 +192,7 @@ begin
GroupHeader1Region := TFPReportGroupHeaderBand.Create(Page);
GroupHeader1Region.Layout.Height := 15;
GroupHeader1Region.GroupCondition := 'region';
GroupHeader1Region.GroupCondition := 'data.region';
GroupHeader1Region.Frame.Shape := fsRectangle;
GroupHeader1Region.Frame.BackgroundColor := clGroupHeaderFooter;
//GroupHeader1Region.StartOnNewPage := True;
@ -209,7 +209,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 16;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := 'Region: [region] ([formatfloat(''#,##0.0'', grp1region_sum_population_in_M)] M)';
Memo.Text := 'Region: [data.region] ([formatfloat(''#,##0.0'', grp1region_sum_population_in_M)] M)';
Memo := TFPReportMemo.Create(GroupHeader1Region);
Memo.Layout.Left := 25;
@ -235,7 +235,7 @@ begin
Memo.Layout.Top := 1;
Memo.Layout.Width := 170;
Memo.Layout.Height := 4;
Memo.Text := 'Region: [region]';
Memo.Text := 'Region: [data.region]';
{*** group header 2 subregion ***}
@ -244,7 +244,7 @@ begin
GroupHeader2Subregion := TFPReportGroupHeaderBand.Create(Page);
GroupHeader2Subregion.Layout.Height := 2;
GroupHeader2Subregion.GroupCondition := 'subregion';
GroupHeader2Subregion.GroupCondition := 'data.subregion';
GroupHeader2Subregion.ParentGroupHeader := GroupHeader1Region;
//GroupHeader2Subregion.StartOnNewPage := True;
GroupHeader2Subregion.ReprintedHeader := [rsPage];
@ -295,7 +295,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 14;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := 'Subregion: [subregion] ([formatfloat(''#,##0.0'', grp2subregion_sum_population_in_M)] M)';
Memo.Text := 'Subregion: [data.subregion] ([formatfloat(''#,##0.0'', grp2subregion_sum_population_in_M)] M)';
Memo := TFPReportMemo.Create(ChildBand);
Memo.Layout.Left := 25;
@ -306,7 +306,7 @@ begin
Memo.Font.Size := 10;
Memo.TextAlignment.Vertical := tlBottom;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#0.0'', grp2subregion_sum_population / grp1region_sum_population * 100)] % in [region] - [formatfloat(''#0.0'', grp2subregion_sum_population / total_sum_population * 100)] % in World';
Memo.Text := '[formatfloat(''#0.0'', grp2subregion_sum_population / grp1region_sum_population * 100)] % in [data.region] - [formatfloat(''#0.0'', grp2subregion_sum_population / total_sum_population * 100)] % in World';
{--- group header 2 subregion - band 3 ---}
@ -340,7 +340,7 @@ begin
Memo.Layout.Top := 1;
Memo.Layout.Width := 170;
Memo.Layout.Height := 4;
Memo.Text := 'Subregion: [subregion]';
Memo.Text := 'Subregion: [data.subregion]';
{*** group header 3 initial ***}
@ -349,7 +349,7 @@ begin
GroupHeader3Initial := TFPReportGroupHeaderBand.Create(Page);
GroupHeader3Initial.Layout.Height := 2;
GroupHeader3Initial.GroupCondition := 'copy(country,1,1)';
GroupHeader3Initial.GroupCondition := 'copy(data.country,1,1)';
GroupHeader3Initial.ParentGroupHeader := GroupHeader2Subregion;
GroupHeader3Initial.ReprintedHeader := [rsPage];
GroupHeader3Initial.IntermediateFooter := [rsPage];
@ -426,7 +426,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 12;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := '[copy(country,1,1)] ([formatfloat(''#,##0.0'', grp3initial_sum_population_in_M)] M)';
Memo.Text := '[copy(data.country,1,1)] ([formatfloat(''#,##0.0'', grp3initial_sum_population_in_M)] M)';
Memo := TFPReportMemo.Create(ChildBand);
Memo.Layout.Left := 25;
@ -437,7 +437,7 @@ begin
Memo.Font.Size := 10;
Memo.TextAlignment.Vertical := tlBottom;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#0.0'', grp3initial_sum_population / grp2subregion_sum_population * 100)] % in [subregion] - [formatfloat(''#0.0'', grp3initial_sum_population / grp1region_sum_population * 100)] % in [region] - [formatfloat(''#0.0'', grp3initial_sum_population / total_sum_population * 100)] % in World';
Memo.Text := '[formatfloat(''#0.0'', grp3initial_sum_population / grp2subregion_sum_population * 100)] % in [data.subregion] - [formatfloat(''#0.0'', grp3initial_sum_population / grp1region_sum_population * 100)] % in [data.region] - [formatfloat(''#0.0'', grp3initial_sum_population / total_sum_population * 100)] % in World';
Memo := TFPReportMemo.Create(ChildBand);
Memo.Layout.Left := 90;
@ -521,7 +521,7 @@ begin
Memo.Layout.Top := 1;
Memo.Layout.Width := 170;
Memo.Layout.Height := 4;
Memo.Text := '[copy(country,1,1)]';
Memo.Text := '[copy(data.country,1,1)]';
{--- group header 3 initial - band 4 ---}
@ -559,15 +559,15 @@ begin
{*** variables ***}
rpt.Variables.AddExprVariable('population_in_M', 'StrToFloat(population) / 1000000', rtFloat, rtNone, '');
rpt.Variables.AddExprVariable('grp1region_sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat, GroupHeader1Region);
rpt.Variables.AddExprVariable('grp1region_sum_population', 'sum(StrToFloat(population))', rtFloat, GroupHeader1Region);
rpt.Variables.AddExprVariable('grp2subregion_sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat, GroupHeader2Subregion);
rpt.Variables.AddExprVariable('grp2subregion_sum_population', 'sum(StrToFloat(population))', rtFloat, GroupHeader2Subregion);
rpt.Variables.AddExprVariable('grp3initial_sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat, GroupHeader3Initial);
rpt.Variables.AddExprVariable('grp3initial_sum_population', 'sum(StrToFloat(population))', rtFloat, GroupHeader3Initial);
rpt.Variables.AddExprVariable('total_sum_population_in_M', 'sum(StrToFloat(population) / 1000000)', rtFloat);
rpt.Variables.AddExprVariable('total_sum_population', 'sum(StrToFloat(population))', rtFloat);
rpt.Variables.AddExprVariable('population_in_M', 'StrToFloat(data.population) / 1000000', rtFloat, rtNone, '');
rpt.Variables.AddExprVariable('grp1region_sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat, GroupHeader1Region);
rpt.Variables.AddExprVariable('grp1region_sum_population', 'sum(StrToFloat(data.population))', rtFloat, GroupHeader1Region);
rpt.Variables.AddExprVariable('grp2subregion_sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat, GroupHeader2Subregion);
rpt.Variables.AddExprVariable('grp2subregion_sum_population', 'sum(StrToFloat(data.population))', rtFloat, GroupHeader2Subregion);
rpt.Variables.AddExprVariable('grp3initial_sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat, GroupHeader3Initial);
rpt.Variables.AddExprVariable('grp3initial_sum_population', 'sum(StrToFloat(data.population))', rtFloat, GroupHeader3Initial);
rpt.Variables.AddExprVariable('total_sum_population_in_M', 'sum(StrToFloat(data.population) / 1000000)', rtFloat);
rpt.Variables.AddExprVariable('total_sum_population', 'sum(StrToFloat(data.population))', rtFloat);
{****************}
@ -639,7 +639,7 @@ begin
Memo.Layout.Top := 2;
Memo.Layout.Width := 45;
Memo.Layout.Height := 5;
Memo.Text := '[country]';
Memo.Text := '[data.country]';
Memo.Options := memo.Options + [moDisableWordWrap];
Memo := TFPReportMemo.Create(DataBand);
@ -648,7 +648,7 @@ begin
Memo.Layout.Width := 25;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0'', StrToFloat(population))]';
Memo.Text := '[formatfloat(''#,##0'', StrToFloat(data.population))]';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 80;
@ -658,7 +658,7 @@ begin
Memo.Text := '> DEU';
Memo.UseParentFont := false;
Memo.Font.Color := clGreen;
Memo.VisibleExpr := 'StrToFloat(population) > 82667685';
Memo.VisibleExpr := 'StrToFloat(data.population) > 82667685';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 80;
@ -668,7 +668,7 @@ begin
Memo.Text := '< DEU';
Memo.UseParentFont := false;
Memo.Font.Color := clRed;
Memo.VisibleExpr := 'StrToFloat(population) < 82667685';
Memo.VisibleExpr := 'StrToFloat(data.population) < 82667685';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 95;
@ -676,7 +676,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/grp3initial_sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/grp3initial_sum_population*100)] %';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 115;
@ -684,7 +684,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/grp2subregion_sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/grp2subregion_sum_population*100)] %';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 135;
@ -692,7 +692,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/grp1region_sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/grp1region_sum_population*100)] %';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 155;
@ -700,7 +700,7 @@ begin
Memo.Layout.Width := 15;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(population)/total_sum_population*100)] %';
Memo.Text := '[formatfloat(''#,##0.0'',StrToFloat(data.population)/total_sum_population*100)] %';
{**********************}
@ -821,7 +821,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 12;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := 'Population [copy(country,1,1)]: [formatfloat(''#,##0'', grp3initial_sum_population)]';
Memo.Text := 'Population [copy(data.country,1,1)]: [formatfloat(''#,##0'', grp3initial_sum_population)]';
{--- group footer 3 initial - band 4 ---}
@ -947,7 +947,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 14;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := 'Population [subregion]: [formatfloat(''#,##0'', grp2subregion_sum_population)]';
Memo.Text := 'Population [data.subregion]: [formatfloat(''#,##0'', grp2subregion_sum_population)]';
{--- group footer 2 subregion - band 4 ---}
@ -1038,7 +1038,7 @@ begin
Memo.UseParentFont := False;
Memo.Font.Size := 16;
Memo.TextAlignment.Vertical := tlBottom;
Memo.Text := 'Population [region]: [formatfloat(''#,##0'', grp1region_sum_population)]';
Memo.Text := 'Population [data.region]: [formatfloat(''#,##0'', grp1region_sum_population)]';
{--- group footer 1 region - band 3 ---}
@ -1182,6 +1182,7 @@ constructor TNestedGroupsDemo.Create(AOWner: TComponent);
begin
inherited;
FReportData := TFPReportUserData.Create(nil);
FReportData.Name := 'Data';
FReportData.OnGetValue := @GetReportDataValue;
FReportData.OnGetEOF := @GetReportDataEOF;
FReportData.OnFirst := @GetReportDataFirst;

2
packages/fcl-report/demos/rptttf.pp
View File

@ -153,7 +153,7 @@ begin
GroupHeader := TFPReportGroupHeaderBand.Create(p);
GroupHeader.Layout.Height := 15;
GroupHeader.Data := lReportData;
GroupHeader.GroupCondition := '[copy(country,1,1)]';
GroupHeader.GroupCondition := 'copy(country,1,1)';
GroupHeader.Frame.BackgroundColor := clYellow; // this has no affect on rendered PDF because here Shape = fsNone
GroupHeader.Frame.Color := TFPReportColor($01579B);
GroupHeader.Frame.Lines := [flBottom];

19
packages/fcl-report/demos/udapp.pp
View File

@ -7,7 +7,7 @@ unit udapp;
interface
uses
Classes, SysUtils, fpttf, fpreport,
Classes, SysUtils, fpttf, fpreport, fpjsonreport,
{$IFDEF ExportPDF}
fpreportpdfexport,
@ -48,14 +48,15 @@ Type
TReportDemoApp = class(TComponent)
private
Frpt: TFPReport;
Frpt: TFPJSONReport;
protected
procedure InitialiseData; virtual;
procedure CreateReportDesign; virtual;
public
procedure TestInit;
Class Function Description : string; virtual;
// procedure DoCreateJSON(const AFileName: String; RunTime: Boolean=False);
Property rpt : TFPReport read Frpt Write FRpt;
Property rpt : TFPJSONReport read Frpt Write FRpt;
end;
TReportDemoAppClass = Class of TReportDemoApp;
@ -144,14 +145,20 @@ begin
PaperManager.RegisterStandardSizes;
end;
procedure TReportDemoApp.TestInit;
begin
Frpt := TFPJSONReport.Create(Self);
InitialiseData;
CreateReportDesign;
end;
class function TReportDemoApp.Description: string;
begin
Result:='';
end;
class function TReportDemoApplication.GetRenderClass(F: TRenderFormat
): TFPReportExporterClass;
class function TReportDemoApplication.GetRenderClass(F: TRenderFormat): TFPReportExporterClass;
begin
Case F of
@ -465,7 +472,7 @@ begin
if (F<>'') and (CompareText(F,'default')<>0) and (Fmt=rfDefault) then
Usage(Format('Unknown output format: %s',[F]));
FRunner.ReportApp:=GetReportClass(D).Create(Self);
FRunner.ReportApp.rpt:=TFPReport.Create(FRunner.ReportApp);
FRunner.ReportApp.rpt:=TFPJSONReport.Create(FRunner.ReportApp);
FRunner.Format:=Fmt;
FRunner.DesignFileName:=J;
FRunner.Execute;

1
packages/fcl-report/src/fpreportcontnr.pp
View File

@ -260,6 +260,7 @@ procedure TFPReportObjectData.DoClose;
begin
FIndex:=-1;
inherited DoClose;
DataFields.Clear;
end;
function TFPReportObjectData.DoEOF: boolean;

1
packages/fcl-report/src/fpreportjson.pp
View File

@ -251,6 +251,7 @@ end;
procedure TFPReportJSONData.DoClose;
begin
inherited DoClose;
DataFields.Clear;
FIndex:=-1;
end;

41
packages/fcl-report/test/README.md Normal file
View File

@ -0,0 +1,41 @@
# Testsuite
## Demos
The testsuite can optionally run all demos: define USEDEMOS and fpTestX on the
command-line or in the lazarus defines.
In that case the ../demo and ../demo/polygon directories must be added to
the unit path of the compiler.
You can then run these tests using the following command-line
./testfpreport --suite=TTestDemos
The demo reports will be rendered and saved to a directory "rendered".
The first time you run the demo test, the file will be called demo.set.json.
The second time you run the demo test, if the result differs, the result
will be saved to a file called demo.actual.json.
So, to test changes, first delete all json files in the rendered directory.
Then do a first run, this will create the initial files, and set a baseline.
Make your changes, and then run the reports again. You will be notified of
differences.
The reason these files are not stored in SVN is that they are dependent on
the platform:
a) The reports contain newlines.
Depending on the platform they will be saved as \r \r\n or \n.
b) There can and will be localization issues.
## Fonts
The demos need some extra fonts.
The needed fonts (Ubuntu and DejaVu Sans) can be downloaded from:
* https://assets.ubuntu.com/v1/0cef8205-ubuntu-font-family-0.83.zip
* https://www.downloadfonts.io/calibri-font-family-free/
* https://www.fontsquirrel.com/fonts/download/dejavu-sans
* https://www.fontsquirrel.com/fonts/download/liberation-sans
These fonts should be saved to the ./fonts or ../demo/fonts directory.

11
packages/fcl-report/test/regtests.pp
View File

@ -4,10 +4,19 @@ unit regtests;
Add all test units to the uses clause here.
Avoids messing with the uses clause of the main program(s).
}
// Define USEDEMOS if you want to test & compare rendering of the demos.
{$DEFINE USEDEMOS}
interface
uses
tcbasereport, tcreportstreamer, tchtmlparser;
tcbasereport, tcreportstreamer, tchtmlparser
{$IFDEF USEDEMOS}
, tcreportgenerator
{$ENDIF}
;
implementation

313
packages/fcl-report/test/tcreportgenerator.pas Normal file
View File

@ -0,0 +1,313 @@
unit tcreportgenerator;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils,
fpcunit,
testregistry,
fpreport,
udapp,
fpTTF,
fpjson,
{demos}
rptsimplelist,
rptexpressions,
rptgrouping,
rptgrouping2,
rptframes,
rptimages,
rptttf,
rptshapes,
rptdataset,
rptcolumns,
rptmasterdetail,
rptjson,
rptcontnr,
rptnestedgroups,
rptBarcode,
rptQRcode;
type
{ TTestDemos }
TTestDemos = class(TTestCase)
private
FFilePath: String;
procedure SaveJSON(pFileName: String; pJSON: TJSONData);
protected
procedure SetUp; override;
procedure TearDown; override;
procedure TestDemo(pName: String; pDemoAppClass: TReportDemoAppClass);
published
procedure SimpleList;
procedure ExpressionDemo;
procedure GroupingDemo;
procedure Grouping2Demo;
procedure FramesDemo;
procedure ImagesDemo;
procedure TTFDemo;
procedure ShapesDemo;
procedure DatasetDemo;
procedure ColumnsDemo;
procedure MasterDetailDemo;
procedure JSONDemo;
procedure CollectionDemo;
procedure ObjectListDemo;
procedure TestNestedGroupDemo;
procedure BarcodeDemo;
procedure QRCodeDemo;
end;
implementation
uses
fpjsonreport,
jsonscanner,
jsonparser;
{ TTestDemos }
procedure TTestDemos.SaveJSON(pFileName: String; pJSON: TJSONData);
var
S: TFileStream;
J: TJSONStringType;
begin
S:=TFileStream.Create(pFileName,fmCreate);
try
J:=pJSON.FormatJSON;
S.WriteBuffer(J[1],Length(J));
finally
S.Free;
end;
end;
procedure TTestDemos.SetUp;
begin
inherited SetUp;
FFilePath:=ExtractFilePath(ParamStr(0));
if not ForceDirectories(FFilePath+'rendered') then
Fail('Could not create directory for rendered JSON');
gTTFontCache.Clear;
gTTFontCache.SearchPath.Add(FFilePath+'fonts/');
gTTFontCache.SearchPath.Add(FFilePath+'../demos/fonts/');
{$IFDEF UNIX}
gTTFontCache.SearchPath.Add(GetUserDir + '.fonts/');
gTTFontCache.SearchPath.Add('/usr/share/fonts/truetype/ubuntu-font-family/');
gTTFontCache.SearchPath.Add('/usr/share/fonts/truetype/ubuntu/');
gTTFontCache.SearchPath.Add('/usr/share/fonts/truetype/dejavu/');
{$ENDIF}
// ask to generate the font cache
gTTFontCache.BuildFontCache;
end;
procedure TTestDemos.TearDown;
begin
inherited TearDown;
end;
procedure TTestDemos.TestDemo(pName: String; pDemoAppClass: TReportDemoAppClass);
var
lApp: TReportDemoApp;
lSetJSON: TJSONData;
lActualJSON: TJSONObject;
S: TFileStream;
P: TJSONParser;
J: TJSONStringType;
lEqual: Boolean;
lSetFile, lActualFile: String;
begin
lSetFile:=FFilePath+'rendered'+PathDelim+pName+'.set.json';
lActualFile:=FFilePath+'rendered'+PathDelim+pName+'.actual.json';
lApp:=pDemoAppClass.Create(Nil);
lActualJSON := TJSONObject.Create;
try
// delete old actual
DeleteFile(lActualFile);
// create Report
lApp.TestInit;
// run first time
lApp.rpt.RunReport;
lApp.rpt.SaveRenderToJSON(lActualJSON);
// delete DateCreated
lActualJSON.GetPath('Report.DateCreated').AsString := '';
//SaveJSON(lSetFile, lActualJSON); // uncomment for regeneration after changes
if Not FileExists(lSetFile) then
begin
SaveJSON(lSetFile, lActualJSON);
Ignore('No previous test result available, saved result for reference');
end;
// load set report
S:=TFileStream.Create(lSetFile,fmOpenRead);
try
P:=TJSONParser.Create(S, []);
try
lSetJSON:=TJSONObject(P.Parse);
// compare reports
lEqual := lSetJSON.AsJSON = lActualJSON.AsJSON;
if not lEqual then
SaveJSON(lActualFile, lActualJSON);
AssertTrue('equal renders', lEqual);
// run a second time
lApp.rpt.RunReport;
lActualJSON.Clear;
lApp.rpt.SaveRenderToJSON(lActualJSON);
// delete DateCreated
lActualJSON.GetPath('Report.DateCreated').AsString := '';
// compare reports
lEqual := lSetJSON.AsJSON = lActualJSON.AsJSON;
if not lEqual then
SaveJSON(lActualFile, lActualJSON);
AssertTrue('equal second renders', lEqual);
finally
lSetJSON.Free;
P.Free;
end;
finally
S.Free;
end;
finally
lActualJSON.Free;
lApp.Free;
end;
end;
procedure TTestDemos.SimpleList;
begin
TestDemo('simplelist', TSimpleListDemo);
end;
procedure TTestDemos.ExpressionDemo;
begin
TestDemo('expression', TExpressionsDemo);
end;
procedure TTestDemos.GroupingDemo;
begin
TestDemo('grouping', TGroupingDemo);
end;
procedure TTestDemos.Grouping2Demo;
begin
TestDemo('grouping2', TGrouping2Demo);
end;
procedure TTestDemos.FramesDemo;
begin
TestDemo('frames', TFramesDemo);
end;
procedure TTestDemos.ImagesDemo;
var
cd: String;
begin
cd := GetCurrentDir;
SetCurrentDir(cd+PathDelim+'..'+PathDelim+'demos');
try
TestDemo('images', TImagesDemo);
finally
SetCurrentDir(cd);
end;
end;
procedure TTestDemos.TTFDemo;
var
cd: String;
begin
cd := GetCurrentDir;
SetCurrentDir(cd+PathDelim+'..'+PathDelim+'demos');
try
TestDemo('ttf', TTTFDemo);
finally
SetCurrentDir(cd);
end;
end;
procedure TTestDemos.ShapesDemo;
begin
TestDemo('shapes', TShapesDemo);
end;
procedure TTestDemos.DatasetDemo;
var
cd: String;
begin
cd := GetCurrentDir;
SetCurrentDir(cd+PathDelim+'..'+PathDelim+'demos');
try
TestDemo('dataset', TDatasetDemo);
finally
SetCurrentDir(cd);
end;
end;
procedure TTestDemos.ColumnsDemo;
begin
TestDemo('columns', TColumnsDemo)
end;
procedure TTestDemos.MasterDetailDemo;
begin
TestDemo('masterdetail', TMasterDetailDemo);
end;
procedure TTestDemos.JSONDemo;
var
cd: String;
begin
cd := GetCurrentDir;
SetCurrentDir(cd+PathDelim+'..'+PathDelim+'demos');
try
TestDemo('json', TJSONDemo);
finally
SetCurrentDir(cd);
end;
end;
procedure TTestDemos.CollectionDemo;
begin
TestDemo('collection', TCollectionDemo);
end;
procedure TTestDemos.ObjectListDemo;
begin
TestDemo('objectlist', TObjectListDemo);
end;
procedure TTestDemos.BarcodeDemo;
begin
TestDemo('barcode', TBarcodeDemo);
end;
procedure TTestDemos.QRCodeDemo;
begin
TestDemo('qrcode', TQRCodeDemo);
end;
procedure TTestDemos.TestNestedGroupDemo;
begin
TestDemo('nestedgroups', TNestedGroupsDemo);
end;
initialization
RegisterTests(
[TTestDemos
]);
end.

2
packages/fcl-report/test/testfpreport.lpi
View File

@ -75,7 +75,7 @@
<Filename Value="testfpreport"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="../src"/>
<OtherUnitFiles Value="../src;../demos;../demos/polygon"/>
<UnitOutputDirectory Value="units"/>
</SearchPaths>
<Parsing>