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

unit rptQRCode;


{$mode objfpc}{$H+}
{$I demos.inc}

interface

uses
  Classes,
  SysUtils,
  fpreport,
  fpreportcontnr,
  fpreportqrcode,
  udapp;

type

  { TCountry }

  TCountry = Class(TCollectionItem)
  private
    FName: String;
    FPopulation: Int64;
  Published
    Property Name : String Read FName Write FName;
    Property Population : Int64 Read FPopulation Write FPopulation;
  end;

  { TCollectionDemo }

  { TQRCodeDemo }

  TQRCodeDemo = class(TReportDemoApp)
  private
    procedure SetQRCodeValue(Sender: TFPReportElement);
  Protected
    FReportData : TFPReportObjectData;
    FQRCode: TFPReportQRcode;
  public
    procedure   InitialiseData; override;
    constructor Create(AOWner :TComponent); override;
    Class function Description : string; override;
    procedure   CreateReportDesign;override;
    procedure   LoadDesignFromFile(const AFilename: string);
    procedure   HookupData(const AComponentName: string; const AData: TFPReportData);
    destructor  Destroy; override;
  end;



implementation

uses
  fpReportStreamer,
  fpTTF,
  fpJSON,
  jsonparser;

procedure TQRCodeDemo.CreateReportDesign;
var
  p: TFPReportPage;
  TitleBand: TFPReportTitleBand;
  DataBand: TFPReportDataBand;
  GroupHeader: TFPReportGroupHeaderBand;
  Memo: TFPReportMemo;
  PageFooter: TFPReportPageFooterBand;
  QR : TFPReportQRcode;
  
begin
  Inherited;
  rpt.Author := 'Michael Van Canneyt';
  rpt.Title := 'FPReport Demo : QR Codes';

  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 := FReportData;
  p.Font.Name := 'LiberationSans';

  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 := 35;
  Memo.Layout.Top := 20;
  Memo.Layout.Width := 80;
  Memo.Layout.Height := 10;
  Memo.Text := 'COUNTRY AND POPULATION AS OF 2014';

  QR:= TFPReportQRcode.Create(TitleBand);
  QR.Layout.Left := 1;
  QR.Layout.Top := 1;
  QR.Layout.Width := 34;
  QR.Layout.Height := 34;
  QR.Value:='https://www.nayuki.io/page/qr-code-generator-library/';
  QR.Center:=True;

  QR:= TFPReportQRcode.Create(TitleBand);
  QR.Layout.Left := 115;
  QR.Layout.Top := 1;
  QR.Layout.Width := 34;
  QR.Layout.Height := 34;
  QR.Value:='https://freepascal.org/';
  QR.Center:=True;

  GroupHeader := TFPReportGroupHeaderBand.Create(p);
  GroupHeader.Layout.Height := 15;
  GroupHeader.GroupCondition := 'copy(''[Name]'',1,1)';
  {$ifdef ColorBands}
  GroupHeader.Frame.Shape := fsRectangle;
  GroupHeader.Frame.BackgroundColor := clGroupHeaderFooter;
  {$endif}

  Memo := TFPReportMemo.Create(GroupHeader);
  Memo.Layout.Left := 0;
  Memo.Layout.Top := 5;
  Memo.Layout.Width := 10;
  Memo.Layout.Height := 8;
  Memo.UseParentFont := False;
  Memo.Text := '[copy(Name,1,1)]';
  Memo.Font.Size := 16;

  DataBand := TFPReportDataBand.Create(p);
  DataBand.Layout.Height := 35;
  {$ifdef ColorBands}
  DataBand.Frame.Shape := fsRectangle;
  DataBand.Frame.BackgroundColor := clDataBand;
  {$endif}

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Left := 15;
  Memo.Layout.Top := 1;
  Memo.Layout.Width := 50;
  Memo.Layout.Height := 20;
  Memo.Text := '[Name]';

  Memo := TFPReportMemo.Create(DataBand);
  Memo.Layout.Left := 70;
  Memo.Layout.Top := 1;
  Memo.Layout.Width := 30;
  Memo.Layout.Height := 5;
  Memo.Text := '[formatfloat(''#,##0'', Population)]';

  FQRCode := TFPReportQRCode.Create(DataBand);
  FQRCode.Layout.Left := 100;
  FQRCode.Layout.Top := 1;
  FQRCode.Layout.Width := 32;
  FQRCode.Layout.Height := 32;
  FQRCode.Center:=True;
  // Only one of the 2 ways must be used: either set expression, either use callback.
  FQRCode.Expression:='''http://en.wikipedia.org/wiki/''+Name';
  // Databand.OnBeforePrint:=@SetQRCodeValue;


  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 := 130;
  Memo.Layout.Top := 13;
  Memo.Layout.Width := 20;
  Memo.Layout.Height := 5;
  Memo.Text := 'Page [PageNo]';
  Memo.TextAlignment.Vertical := tlCenter;
  Memo.TextAlignment.Horizontal := taRightJustified;
end;

procedure TQRCodeDemo.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 TQRCodeDemo.HookupData(const AComponentName: string; const AData: TFPReportData);
var
  b: TFPReportCustomBandWithData;
begin
  b := TFPReportCustomBandWithData(rpt.FindRecursive(AComponentName));
  if Assigned(b) then
    b.Data := AData;
end;

destructor TQRCodeDemo.Destroy;
begin
  FreeAndNil(FReportData);
  inherited Destroy;
end;

constructor TQRCodeDemo.Create(AOWner: TComponent);
begin
  inherited;
  FReportData := TFPReportCollectionData.Create(nil);
  TFPReportCollectionData(FReportData).OwnsCollection:=True;
end;

class function TQRCodeDemo.Description: string;
begin
  Result:='Demo showing native support for QRCodes';
end;

{ TQRCodeDemo }

procedure TQRCodeDemo.SetQRcodeValue(Sender: TFPReportElement);

begin
  FQRCode.Value:='http://en.wikipedia.org/wiki/'+FReportData.FieldValues['Name'];
end;

procedure TQRCodeDemo.InitialiseData;

var
  SL : TStringList;
  i : Integer;
  N,V : String;
  C : TCountry;
  Coll : TCollection;

begin
  Coll:=TCollection.Create(TCountry);
  TFPReportCollectionData(FReportData).Collection:=coll;
  SL:=TStringList.Create;
  try
    {$I countries.inc}
    SL.Sort;
    For I:=0 to SL.Count-1 do
      begin
      C:=Coll.Add As TCountry;
      SL.GetNameValue(I,N,V);
      C.Name:=N;
      C.Population:=StrToInt64Def(V,0);
      end;
  finally
    SL.Free;
  end;
end;

end.