freepascal.compiler/packages/fcl-report/demos/rptgrouping2.pp

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 := 'Total for [data.continent]: [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.