فهرست منبع

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

git-svn-id: trunk@37666 -
michael 7 سال پیش
والد
کامیت
4467ff81a6
2فایلهای تغییر یافته به همراه316 افزوده شده و 0 حذف شده
  1. 1 0
      .gitattributes
  2. 315 0
      packages/fcl-report/demos/rptgrouping2.pp

+ 1 - 0
.gitattributes

@@ -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 - 0
packages/fcl-report/demos/rptgrouping2.pp

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