* QR Code printable element, plus demo report, using newly added QR Code generator unit

git-svn-id: trunk@37438 -

.gitattributes

@@ -2787,6 +2787,7 @@ packages/fcl-report/demos/rptjson.pp svneol=native#text/plain
 packages/fcl-report/demos/rptmasterdetail.pp svneol=native#text/plain
 packages/fcl-report/demos/rptmasterdetaildataset.pp svneol=native#text/plain
 packages/fcl-report/demos/rptnestedgroups.pp svneol=native#text/plain
+packages/fcl-report/demos/rptqrcode.pp svneol=native#text/plain
 packages/fcl-report/demos/rptshapes.pp svneol=native#text/plain
 packages/fcl-report/demos/rptsimplelist.pp svneol=native#text/plain
 packages/fcl-report/demos/rptttf.pp svneol=native#text/plain
@@ -2813,6 +2814,7 @@ packages/fcl-report/src/fpreporthtmlparser.pp svneol=native#text/plain
 packages/fcl-report/src/fpreporthtmlutil.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportjson.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportpdfexport.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportqrcode.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportstreamer.pp svneol=native#text/plain
 packages/fcl-report/test/fonts/LiberationSerif-Regular.ttf -text
 packages/fcl-report/test/fonts/calibri.ttf -text

packages/fcl-report/demos/fcldemo.lpi

@@ -35,7 +35,7 @@
         <CommandLineParams Value="-d barcode -f fpimage"/>
       </local>
     </RunParams>
-    <Units Count="17">
+    <Units Count="18">
       <Unit0>
         <Filename Value="fcldemo.pp"/>
         <IsPartOfProject Value="True"/>
@@ -104,6 +104,11 @@
         <Filename Value="rptbarcode.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit16>
+      <Unit17>
+        <Filename Value="rptqrcode.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="rptQRCode"/>
+      </Unit17>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-report/demos/regreports.pp

@@ -24,6 +24,7 @@ uses
   rptcontnr,
   rptnestedgroups,
   rptBarcode,
+  rptQRcode,
   udapp
   ;
 
@@ -59,6 +60,7 @@ begin
   R('objectlistdata',TObjectListDemo);
   R('nestedgroups',TNestedGroupsDemo);
   R('barcode',TBarcodeDemo);
+  R('QRCode',TQRcodeDemo);
 end;
 
 initialization

packages/fcl-report/demos/rptqrcode.pp

@@ -0,0 +1,273 @@
+unit rptQRCode;
+
+
+{$mode objfpc}{$H+}
+{$I demos.inc}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpreport,
+  fpreportcontnr,
+  fpqrcodegen,
+  fpreportqrcode,
+  contnrs,
+  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:='http://nayuki.io/';
+  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.
+

packages/fcl-report/fpmake.pp

@@ -109,6 +109,17 @@ begin
       AddUnit('fpreport');
       AddUnit('fpreporthtmlutil');
       end;
+    T:=P.Targets.AddUnit('fpreportbarcode.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      end;
+   T:=P.Targets.AddUnit('fpreportqrcode.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      end;
+
 {$ifndef ALLPACKAGES}
     Run;
     end;

packages/fcl-report/src/fpreportqrcode.pp

@@ -0,0 +1,216 @@
+{
+    This file is part of the Free Component Library.
+    Copyright (c) 2017 Michael Van Canneyt, member of the Free Pascal development team
+
+    QR Code report element.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpreportqrcode;
+
+{$MODE objfpc}
+{$H+}
+
+interface
+
+uses
+  Classes, fpimage, fpexprpars, fpimgqrcode, fpqrcodegen, fpreport, fpreportstreamer;
+
+Type
+
+  { TFPReportQRCode }
+
+  TFPReportQRCode = Class(TFPReportElement)
+  private
+    FExpression: String;
+    FPixelSize: Integer;
+    FValue: String;
+    FExprValue : String;
+    FMask : TQRMask;
+    FECL : TQRErrorLevelCorrection;
+    FCenter : Boolean;
+  Protected
+    procedure BeforePrint;  override;
+    procedure RecalcLayout; override;
+    Procedure DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement=nil); override;
+  Public
+    procedure Assign(Source: TPersistent); override;
+    // Will calculate the value to display. Either Value or evaluated expression.
+    Function QRCodeValue : String;
+    Function QRPixelSize(aWidth,aHeight,aQRSize : Integer)  : Integer;
+    Procedure ReadElement(AReader: TFPReportStreamer); override;
+  Published
+    // If zero or less, it will be calculated from width/height, truncated, after calculating the QR size.
+    Property PixelSize : Integer Read FPixelSize Write FPixelSize;
+    // Expression takes precedence
+    Property Value : String Read FValue Write FValue;
+    Property Expression : String Read FExpression Write FExpression;
+    Property Mask : TQRMask Read FMask Write FMask;
+    Property ErrorCorrectionLevel : TQRErrorLevelCorrection Read FECL Write FECL;
+    Property Center : Boolean Read FCenter Write FCenter;
+  end;
+
+Procedure RegisterReportQRCode;
+Procedure UnRegisterReportQRCode;
+  
+implementation
+
+uses typinfo, strutils;
+
+
+{ TFPReportQRCode }
+
+procedure TFPReportQRCode.RecalcLayout;
+begin
+  // Do nothing for the moment.
+  // We may consider adding a Boolean property FitWidth and calculating width based on value/expression when it is set to true
+end;
+
+procedure TFPReportQRCode.DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement);
+
+
+begin
+  inherited DoWriteLocalProperties(AWriter, AOriginal);
+  AWriter.WriteInteger('PixelSize',PixelSize);
+  AWriter.WriteString('Value',Value);
+  AWriter.WriteString('Expression',Expression);
+  AWriter.WriteString('Mask',GetEnumName(TypeInfo(TQRMask),Ord(Mask)));
+  AWriter.WriteString('ErrorCorrectionLevel',GetEnumName(TypeInfo(TQRErrorLevelCorrection),Ord(ErrorCorrectionLevel)));
+  AWriter.WriteBoolean('Center',Center);
+end;
+
+procedure TFPReportQRCode.Assign(Source: TPersistent);
+
+Var
+  QRC : TFPReportQRCode;
+
+begin
+  if (Source is TFPReportQRCode) then
+    begin
+    QRC:=TFPReportQRCode(Source);
+    FValue:=QRC.FValue;
+    FExpression:=QRC.FExpression;
+    FPixelSize:=QRC.FPixelSize;
+    FMask:=QRC.FMask;
+    FECl:=QRC.FECL;
+    FCenter:=QRC.Center;
+    end;
+  inherited Assign(Source);
+end;
+
+
+procedure TFPReportQRCode.BeforePrint;
+
+begin
+  Inherited;
+  if (FExpression<>'') then
+  FExprValue:=EvaluateExpressionAsText(FExpression)
+end;
+
+function TFPReportQRCode.QRCodeValue: String;
+
+begin
+  if (FExpression<>'') then
+    Result:=FExprValue // Calculated in beforeprint
+  else
+    Result:=FValue;
+end;
+
+function TFPReportQRCode.QRPixelSize (aWidth,aHeight,aQRSize : Integer) : Integer;
+
+Var
+  PS2 : Integer;
+
+begin
+  Result:=FPixelSize;
+  if (Result<=0) and (aQRSize>0) then
+    begin
+    Result:=aWidth div aQRSize;
+    PS2:=aHeight div aQRSize;
+    if PS2<Result then
+      Result:=PS2;
+    end;
+  if Result<1 then
+    Result:=1;  
+end;
+
+procedure TFPReportQRCode.ReadElement(AReader: TFPReportStreamer);
+
+Var
+  S : String;
+  I : Integer;
+
+begin
+  inherited ReadElement(AReader);
+  PixelSize:=AReader.ReadInteger('UnitWidth',PixelSize);
+  Value:=AReader.ReadString('Value',Value);
+  Expression:=AReader.ReadString('Expression',Expression);
+  I:=GetEnumValue(TypeInfo(TQRMask), Areader.ReadString('Mask',''));
+  if I<>-1 then
+    FMask:=TQRMask(I);
+  I:=GetEnumValue(TypeInfo(TQRErrorLevelCorrection),AReader.ReadString('ErrorCorrectionLevel',''));
+  if I<>-1 then
+    FECL:=TQRErrorLevelCorrection(I);
+  Center:=AReader.ReadBoolean('Center',Center);
+end;
+
+procedure RenderQRCode(aElement: TFPReportElement; aImage: TFPCustomImage);
+
+Var
+  D : TImageQRCodeGenerator;
+  Q : TFPReportQRCode;
+  DD,PX,PY : Integer;
+  
+
+begin
+  Q:=TFPReportQRCode(aElement);
+  D:=TImageQRCodeGenerator.Create;
+  try
+    D.MinVersion:=QRVERSIONMIN;
+    D.MaxVersion:=QRVERSIONMAX;
+    D.ErrorCorrectionLevel:=Q.ErrorCorrectionLevel;
+    D.Mask:=Q.Mask;
+    D.Generate(Q.QRCodeValue);
+    D.PixelSize:=Q.QRPixelSize(aImage.Width,aImage.height,D.Size);
+    PX:=0;
+    PY:=0;
+    if Q.Center then
+     begin
+     DD:=aImage.Width-(D.PixelSize*D.Size);
+     if DD>0 then
+       PX:=DD div 2;
+     DD:=aImage.Height-(D.PixelSize*D.Size);
+     if DD>0 then
+       PY:=DD div 2;
+     end; 
+    D.Origin:=Point(PX,PY);
+    D.Draw(aImage);
+  finally
+    D.Free;
+  end;
+end;
+
+
+Procedure RegisterReportQRCode;
+
+begin
+  gElementFactory.RegisterClass('QRCode',TFPReportQRCode);
+  // Fallback renderer
+  gElementFactory.RegisterImageRenderer(TFPReportQRCode,@RenderQRCode);
+end;
+
+Procedure UnRegisterReportQRCode;
+
+begin
+  gElementFactory.RemoveClass('QRCode');
+end;
+
+initialization
+  RegisterReportQRcode;
+end.