mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 00:19:24 +02:00
* Second grouping demo, showing fieldkind for user data loop and simple aggregates
git-svn-id: trunk@37666 -
This commit is contained in:
michael
parent
cc08fe73df
commit
4467ff81a6
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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/rptframes.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/rptjson.pp svneol=native#text/plain
|
||||
packages/fcl-report/demos/rptmasterdetail.pp svneol=native#text/plain
|
||||
|
||||
315
packages/fcl-report/demos/rptgrouping2.pp
Normal file
315
packages/fcl-report/demos/rptgrouping2.pp
Normal 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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user