paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 18:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Second grouping demo, showing fieldkind for user data loop and simple aggregates

Browse Source 
git-svn-id: trunk@37666 -
This commit is contained in:
michael 2017-12-03 10:25:05 +00:00
parent cc08fe73df
commit 4467ff81a6
2 changed files with 316 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -2786,6 +2786,7 @@ packages/fcl-report/demos/rptdataset.pp svneol=native#text/plain
packages/fcl-report/demos/rptexpressions.pp svneol=native#text/plain packages/fcl-report/demos/rptexpressions.pp svneol=native#text/plain
packages/fcl-report/demos/rptframes.pp svneol=native#text/plain packages/fcl-report/demos/rptframes.pp svneol=native#text/plain
packages/fcl-report/demos/rptgrouping.pp svneol=native#text/plain packages/fcl-report/demos/rptgrouping.pp svneol=native#text/plain
packages/fcl-report/demos/rptgrouping2.pp svneol=native#text/plain
packages/fcl-report/demos/rptimages.pp svneol=native#text/plain packages/fcl-report/demos/rptimages.pp svneol=native#text/plain
packages/fcl-report/demos/rptjson.pp svneol=native#text/plain packages/fcl-report/demos/rptjson.pp svneol=native#text/plain
packages/fcl-report/demos/rptmasterdetail.pp svneol=native#text/plain packages/fcl-report/demos/rptmasterdetail.pp svneol=native#text/plain

315
packages/fcl-report/demos/rptgrouping2.pp Normal file
View File

@ -0,0 +1,315 @@
unit rptgrouping2;
{$mode objfpc}{$H+}
{$I demos.inc}
interface
uses
Classes,
SysUtils,
fpreport,
strutils,
udapp;
type
{ TGrouping2Demo }
TGrouping2Demo = class(TReportDemoApp)
private
lReportData: TFPReportUserData;
sl: TStringList;
procedure GetReportDataFirst(Sender: TObject);
procedure GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
procedure GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
procedure GetReportFieldKind(Sender: TObject; aName: String; var AKind: TFPReportFieldKind);
procedure GetReportFieldNames(Sender: TObject; List: TStrings);
Protected
procedure InitialiseData; override;
procedure CreateReportDesign;override;
procedure LoadDesignFromFile(const AFilename: string);
procedure HookupData(const AComponentName: string; const AData: TFPReportData);
public
constructor Create(AOWner :TComponent); override;
destructor Destroy; override;
Class function Description : string; override;
end;
implementation
uses
fpReportStreamer,
fpTTF,
fpJSON,
jsonparser,
fpexprpars;
{ TGrouping2Demo }
procedure TGrouping2Demo.GetReportDataFirst(Sender: TObject);
begin
{$IFDEF gdebug}
writeln('GetReportDataFirst');
{$ENDIF}
end;
procedure TGrouping2Demo.GetReportDataValue(Sender: TObject; const AValueName: String; var AValue: Variant);
Var
W : Integer;
S : String;
begin
{$IFDEF gdebug}
writeln(Format('GetReportDataValue - %d', [lReportData.RecNo]));
{$ENDIF}
W:=0;
Case LowerCase(AValueName) of
'continent' : W:=1;
'region' : W:=2;
'country' : W:=3;
'iso' : W:=4;
'population' : W:=5;
end;
If W=0 then
AValue:=''
else
begin
S:=ExtractWord(W,sl[lReportData.RecNo-1],[';']);
if W=5 then
AValue:=StrToIntDef(S,5)
else
AValue:=S;
end;
end;
procedure TGrouping2Demo.GetReportDataEOF(Sender: TObject; var IsEOF: Boolean);
begin
{$IFDEF gdebug}
writeln(Format('GetReportDataEOF - %d', [lReportData.RecNo]));
{$ENDIF}
if lReportData.RecNo > sl.Count then
IsEOF := True
else
IsEOF := False;
end;
procedure TGrouping2Demo.GetReportFieldKind(Sender: TObject; aName: String; var AKind: TFPReportFieldKind);
begin
if CompareText('population',aname)=0 then
aKind:=rfkInteger;
end;
procedure TGrouping2Demo.GetReportFieldNames(Sender: TObject; List: TStrings);
begin
{$IFDEF gdebug}
writeln('********** GetReportFieldNames');
{$ENDIF}
List.Add('continent');
List.Add('region');
List.Add('country');
List.Add('ISO');
List.Add('population');
end;
procedure TGrouping2Demo.InitialiseData;
begin
sl := TStringList.Create;
{$I countries2.inc}
sl.Sort;
end;
procedure TGrouping2Demo.CreateReportDesign;
var
p: TFPReportPage;
TitleBand: TFPReportTitleBand;
DataBand: TFPReportDataBand;
GroupHeader: TFPReportGroupHeaderBand;
Memo: TFPReportMemo;
PageFooter: TFPReportPageFooterBand;
GroupFooter: TFPReportGroupFooterBand;
begin
Inherited;
rpt.Author := 'Graeme Geldenhuys';
rpt.Title := 'FPReport Demo 3 - Grouping';
{*** page ***}
p := TFPReportPage.Create(rpt);
p.Orientation := poPortrait;
p.PageSize.PaperName := 'A4';
{ page margins }
p.Margins.Left := 30;
p.Margins.Top := 20;
p.Margins.Right := 30;
p.Margins.Bottom := 20;
p.Data := lReportData;
p.Font.Name := 'LiberationSans';
{*** title ***}
TitleBand := TFPReportTitleBand.Create(p);
TitleBand.Layout.Height := 40;
{$IFDEF ColorBands}
TitleBand.Frame.Shape := fsRectangle;
TitleBand.Frame.BackgroundColor := clReportTitleSummary;
{$ENDIF}
Memo := TFPReportMemo.Create(TitleBand);
Memo.Layout.Left := 0;
Memo.Layout.Top := 20;
Memo.Layout.Width := p.PageSize.Width - p.Margins.Left - p.Margins.Right;
Memo.Layout.Height := 10;
Memo.TextAlignment.Horizontal := taCentered;
Memo.Text := 'COUNTRY AND POPULATION AS OF 2014';
GroupHeader := TFPReportGroupHeaderBand.Create(p);
GroupHeader.Layout.Height := 15;
GroupHeader.GroupCondition := 'data.continent';
{$ifdef ColorBands}
GroupHeader.Frame.Shape := fsRectangle;
GroupHeader.Frame.BackgroundColor := clGroupHeaderFooter;
{$endif}
Memo := TFPReportMemo.Create(GroupHeader);
Memo.Layout.Left := 5;
Memo.Layout.Top := 3;
Memo.Layout.Width := 10;
Memo.Layout.Height := 8;
Memo.UseParentFont := False;
Memo.Text := '[data.continent]';
Memo.Font.Size := 16;
{*** detail ***}
DataBand := TFPReportDataBand.Create(p);
DataBand.Layout.Height := 8;
{$ifdef ColorBands}
DataBand.Frame.Shape := fsRectangle;
DataBand.Frame.BackgroundColor := clDataBand;
{$endif}
//DataBand.VisibleExpr := 'StrToFloat(''[population]'') > 50000000';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 15;
Memo.Layout.Top := 2;
Memo.Layout.Width := 45;
Memo.Layout.Height := 5;
Memo.Text := '[data.country]';
Memo := TFPReportMemo.Create(DataBand);
Memo.Layout.Left := 55;
Memo.Layout.Top := 2;
Memo.Layout.Width := 25;
Memo.Layout.Height := 5;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[data.population]';
{*** group footer ***}
GroupFooter := TFPReportGroupFooterBand.Create(p);
GroupFooter.Layout.Height := 15;
GroupFooter.GroupHeader := GroupHeader;
{$ifdef ColorBands}
GroupFooter.Frame.Shape := fsRectangle;
GroupFooter.Frame.BackgroundColor := clGroupHeaderFooter;
{$endif}
Memo := TFPReportMemo.Create(GroupFooter);
Memo.Layout.Left := 25;
Memo.Layout.Top := 5;
Memo.Layout.Width := 100;
Memo.Layout.Height := 8;
Memo.UseParentFont := False;
Memo.TextAlignment.Horizontal := taRightJustified;
Memo.Text := '[FormatFloat(''#,###0.00'',sum(data.population/1000000))] million';
// Memo.Options:=Memo.Options+[moNoResetAggregateOnPrint];
Memo.Font.Size := 16;
{*** page footer ***}
PageFooter := TFPReportPageFooterBand.Create(p);
PageFooter.Layout.Height := 20;
{$ifdef ColorBands}
PageFooter.Frame.Shape := fsRectangle;
PageFooter.Frame.BackgroundColor := clPageHeaderFooter;
{$endif}
Memo := TFPReportMemo.Create(PageFooter);
Memo.Layout.Left := 100;
Memo.Layout.Top := 13;
Memo.Layout.Width := 50;
Memo.Layout.Height := 5;
Memo.Text := 'Page [PageNo] of [PAGECOUNT]';
Memo.TextAlignment.Vertical := tlCenter;
Memo.TextAlignment.Horizontal := taRightJustified;
end;
procedure TGrouping2Demo.LoadDesignFromFile(const AFilename: string);
var
rs: TFPReportJSONStreamer;
fs: TFileStream;
lJSON: TJSONObject;
begin
if AFilename = '' then
Exit;
if not FileExists(AFilename) then
raise Exception.CreateFmt('The file "%s" can not be found', [AFilename]);
fs := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone);
try
lJSON := TJSONObject(GetJSON(fs));
finally
fs.Free;
end;
rs := TFPReportJSONStreamer.Create(nil);
rs.JSON := lJSON; // rs takes ownership of lJSON
try
rpt.ReadElement(rs);
finally
rs.Free;
end;
end;
procedure TGrouping2Demo.HookupData(const AComponentName: string; const AData: TFPReportData);
var
b: TFPReportCustomBandWithData;
begin
b := TFPReportCustomBandWithData(rpt.FindRecursive(AComponentName));
if Assigned(b) then
b.Data := AData;
end;
constructor TGrouping2Demo.Create(AOwner: TComponent);
begin
inherited;
lReportData := TFPReportUserData.Create(nil);
lReportData.Name:='Data';
lReportData.OnGetValue := @GetReportDataValue;
lReportData.OnGetEOF := @GetReportDataEOF;
lReportData.OnFirst := @GetReportDataFirst;
lReportData.OnGetNames := @GetReportFieldNames;
lReportData.OnGetFieldKind:=@GetReportFieldKind;
end;
destructor TGrouping2Demo.Destroy;
begin
FreeAndNil(lReportData);
FreeAndNil(sl);
inherited Destroy;
end;
class function TGrouping2Demo.Description: string;
begin
Result:='Demo showing grouping and totals';
end;
end.