diff --git a/.gitattributes b/.gitattributes
index 552ee5c90b..58d253e174 100644
--- a/.gitattributes
+++ b/.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
diff --git a/packages/fcl-report/demos/fcldemo.lpi b/packages/fcl-report/demos/fcldemo.lpi
index 92dcccb0c9..559a221f30 100644
--- a/packages/fcl-report/demos/fcldemo.lpi
+++ b/packages/fcl-report/demos/fcldemo.lpi
@@ -35,7 +35,7 @@
-
+
@@ -104,6 +104,11 @@
+
+
+
+
+
diff --git a/packages/fcl-report/demos/regreports.pp b/packages/fcl-report/demos/regreports.pp
index 077d3628b8..a27490c077 100644
--- a/packages/fcl-report/demos/regreports.pp
+++ b/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
diff --git a/packages/fcl-report/demos/rptqrcode.pp b/packages/fcl-report/demos/rptqrcode.pp
new file mode 100644
index 0000000000..9e8f4a699f
--- /dev/null
+++ b/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.
+
diff --git a/packages/fcl-report/fpmake.pp b/packages/fcl-report/fpmake.pp
index a0891592ff..d5b21059da 100644
--- a/packages/fcl-report/fpmake.pp
+++ b/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;
diff --git a/packages/fcl-report/src/fpreportqrcode.pp b/packages/fcl-report/src/fpreportqrcode.pp
new file mode 100644
index 0000000000..e8a86654e4
--- /dev/null
+++ b/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-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.