|
@@ -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.
|
|
|
+
|