* Add barcode support

git-svn-id: trunk@37313 -

.gitattributes

@@ -2767,6 +2767,7 @@ packages/fcl-report/demos/polygon/testpolygon.lpi svneol=native#text/plain
 packages/fcl-report/demos/polygon/testpolygon.lpr svneol=native#text/plain
 packages/fcl-report/demos/polygon/testpolygon.res -text
 packages/fcl-report/demos/regreports.pp svneol=native#text/plain
+packages/fcl-report/demos/rptbarcode.pp svneol=native#text/plain
 packages/fcl-report/demos/rptcolumns.pp svneol=native#text/plain
 packages/fcl-report/demos/rptcontnr.pp svneol=native#text/plain
 packages/fcl-report/demos/rptdataset.pp svneol=native#text/plain
@@ -2790,6 +2791,7 @@ packages/fcl-report/src/fpextfuncs.pp svneol=native#text/plain
 packages/fcl-report/src/fpjsonreport.pp svneol=native#text/plain
 packages/fcl-report/src/fprepexprpars.pp svneol=native#text/plain
 packages/fcl-report/src/fpreport.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportbarcode.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportcanvashelper.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportcheckbox.inc svneol=native#text/plain
 packages/fcl-report/src/fpreportcontnr.pp svneol=native#text/plain

packages/fcl-report/demos/fcldemo.lpi

@@ -32,10 +32,10 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-d simplelist -f fpimage"/>
+        <CommandLineParams Value="-d barcode -f fpimage"/>
       </local>
     </RunParams>
-    <Units Count="16">
+    <Units Count="17">
       <Unit0>
         <Filename Value="fcldemo.pp"/>
         <IsPartOfProject Value="True"/>
@@ -100,6 +100,10 @@
         <Filename Value="rptnestedgroups.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit15>
+      <Unit16>
+        <Filename Value="rptbarcode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit16>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/fcl-report/demos/fcldemo.pp

@@ -1,7 +1,7 @@
 program fcldemo;
 
 uses
-  udapp, fpextfuncs, regreports;
+  udapp, fpextfuncs, regreports, fpreportbarcode;
 
 Var
   Application : TReportDemoApplication;

packages/fcl-report/demos/regreports.pp

@@ -23,6 +23,7 @@ uses
   rptjson,
   rptcontnr,
   rptnestedgroups,
+  rptBarcode,
   udapp
   ;
 
@@ -57,6 +58,7 @@ begin
   R('collectiondata',TCollectionDemo);
   R('objectlistdata',TObjectListDemo);
   R('nestedgroups',TNestedGroupsDemo);
+  R('barcode',TBarcodeDemo);
 end;
 
 initialization

packages/fcl-report/demos/rptbarcode.pp

@@ -0,0 +1,256 @@
+unit rptbarcode;
+
+
+{$mode objfpc}{$H+}
+{$I demos.inc}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpreport,
+  fpreportcontnr,
+  fpreportbarcode,
+  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 }
+
+  { TBarcodeDemo }
+
+  TBarcodeDemo = class(TReportDemoApp)
+  private
+    procedure SetBarcodeValue(Sender: TFPReportElement);
+  Protected
+    FReportData : TFPReportObjectData;
+    FBarcode: TFPReportBarcode;
+  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 TBarcodeDemo.CreateReportDesign;
+var
+  p: TFPReportPage;
+  TitleBand: TFPReportTitleBand;
+  DataBand: TFPReportDataBand;
+  GroupHeader: TFPReportGroupHeaderBand;
+  Memo: TFPReportMemo;
+  PageFooter: TFPReportPageFooterBand;
+
+begin
+  Inherited;
+  rpt.Author := 'Michael Van Canneyt';
+  rpt.Title := 'FPReport Demo : Barcodes';
+
+  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';
+
+  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 := 8;
+  {$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 := 5;
+  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)]';
+
+  FBarcode := TFPReportBarcode.Create(DataBand);
+  FBarcode.Layout.Left := 100;
+  FBarcode.Layout.Top := 1;
+  FBarcode.Layout.Width := 50;
+  FBarcode.Layout.Height := 5;
+  FBarCode.PadLength:=12;
+  // Only one of the 2 ways must be used: either set expression, either use callback.
+  FBarcode.Expression:='Population';
+  // Databand.OnBeforePrint:=@SetBarcodeValue;
+
+
+  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 TBarcodeDemo.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 TBarcodeDemo.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 TBarcodeDemo.Destroy;
+begin
+  FreeAndNil(FReportData);
+  inherited Destroy;
+end;
+
+constructor TBarcodeDemo.Create(AOWner: TComponent);
+begin
+  inherited;
+  FReportData := TFPReportCollectionData.Create(nil);
+  TFPReportCollectionData(FReportData).OwnsCollection:=True;
+end;
+
+class function TBarcodeDemo.Description: string;
+begin
+  Result:='Demo showing native support for barcodes';
+end;
+
+{ TBarcodeDemo }
+
+procedure TBarcodeDemo.SetBarcodeValue(Sender: TFPReportElement);
+
+begin
+  FBarcode.Value:=FReportData.FieldValues['Population'];
+  Writeln(FBarcode.Value);
+end;
+
+procedure TBarcodeDemo.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/src/fpreportbarcode.pp

@@ -0,0 +1,175 @@
+unit fpreportbarcode;
+
+interface
+
+uses
+  Classes, fpimage, fpexprpars, fpimgbarcode, fpbarcode, fpreport, fpreportstreamer;
+
+Type
+
+  { TFPReportBarcode }
+
+  TFPReportBarcode = Class(TFPReportElement)
+  private
+    FEncoding: TBarcodeEncoding;
+    FExpression: String;
+    FPadLength: Integer;
+    FUnitWidth: Integer;
+    FValue: String;
+    FExprValue : String;
+    FWeight: Double;
+  Protected
+    procedure BeforePrint;  override;
+    procedure RecalcLayout; override;
+    Procedure DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement=nil); override;
+  Public
+    procedure   Assign(Source: TPersistent); override;
+    Constructor Create(AOwner: TComponent); override;
+    // Will calculate the value to display. Either Value or evaluated expression.
+    Function BarcodeValue : String;
+    Procedure ReadElement(AReader: TFPReportStreamer); override;
+  Published
+    Property Encoding : TBarcodeEncoding Read FEncoding Write FEncoding;
+    Property UnitWidth : Integer Read FUnitWidth Write FUnitWidth;
+    Property Weight : Double Read FWeight Write FWeight;
+    Property PadLength : Integer Read FPadLength Write FPadLength;
+    // Expression takes precedence
+    Property Value : String Read FValue Write FValue;
+    Property Expression : String Read FExpression Write FExpression;
+  end;
+
+Procedure RegisterReportBarcode;
+Procedure UnRegisterReportBarcode;
+  
+implementation
+
+uses typinfo, strutils;
+
+
+{ TFPReportBarcode }
+
+procedure TFPReportBarcode.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 TFPReportBarcode.DoWriteLocalProperties(AWriter: TFPReportStreamer; AOriginal: TFPReportElement);
+
+
+begin
+  inherited DoWriteLocalProperties(AWriter, AOriginal);
+  AWriter.WriteString('Encoding',GetEnumName(TypeInfo(TBarcodeEncoding),Ord(FEncoding)));
+  AWriter.WriteInteger('UnitWidth',UnitWidth);
+  AWriter.WriteInteger('PadLength',PadLength);
+  AWriter.WriteFloat('Weight',Weight);
+  AWriter.WriteString('Value',Value);
+  AWriter.WriteString('Expression',Expression);
+end;
+
+procedure TFPReportBarcode.Assign(Source: TPersistent);
+
+Var
+  BC : TFPReportBarcode;
+
+begin
+  if (Source is TFPReportBarcode) then
+    begin
+    BC:=TFPReportBarcode(Source);
+    FValue:=BC.Value;
+    FPadlength:=BC.PadLength;
+    FExpression:=BC.Expression;
+    FWeight:=BC.Weight;
+    FUnitWidth:=BC.UnitWidth;
+    FEncoding:=BC.Encoding;
+    end;
+  inherited Assign(Source);
+end;
+
+constructor TFPReportBarcode.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FEncoding:=be128A;
+  FUnitWidth:=1;
+  FWeight:=2.0;
+end;
+
+procedure TFPReportBarcode.BeforePrint;
+
+begin
+  Inherited;
+  if (FExpression<>'') then
+  FExprValue:=EvaluateExpressionAsText(FExpression)
+end;
+
+function TFPReportBarcode.BarcodeValue: String;
+
+begin
+  if (FExpression<>'') then
+    Result:=FExprValue // Calculated in beforeprint
+  else
+    Result:=FValue;
+  Result:=AddChar('0',Result,PadLength);
+end;
+
+procedure TFPReportBarcode.ReadElement(AReader: TFPReportStreamer);
+
+Var
+  S : String;
+  I : Integer;
+
+begin
+  inherited ReadElement(AReader);
+  S:=AReader.ReadString('Encoding','beEan8');
+  I:=GetEnumValue(TypeInfo(TBarcodeEncoding),S);
+  if I<>-1 then
+    FEncoding:=TBarcodeEncoding(I);
+  UnitWidth:=AReader.ReadInteger('UnitWidth',UnitWidth);
+  PadLength:=AReader.ReadInteger('UnitWidth',PadLength);
+  Weight:=AReader.ReadFloat('Weight',Weight);
+  Value:=AReader.ReadString('Value',Value);
+  Expression:=AReader.ReadString('Expression',Expression);
+end;
+
+procedure RenderBarcode(aElement: TFPReportElement; aImage: TFPCustomImage);
+
+Var
+  D : TFPDrawBarcode;
+  B : TFPReportBarcode;
+
+begin
+  B:=TFPReportBarcode(aElement);
+  D:=TFPDrawBarcode.Create;
+  try
+    D.Image:=aImage;
+    D.Weight:=B.Weight;
+    D.UnitWidth:=B.UnitWidth;
+    D.Rect:=Rect(0,0,aImage.Width-1,aImage.Height-1);
+    D.Text:=B.BarcodeValue;
+    // Writeln('Weight: ',D.Weight,' unitwidth:',D.UnitWidth,' ',aImage.Width-1,'x',aImage.Height-1,' Text: ',D.Text);
+    D.Encoding:=B.Encoding;
+    D.Clipping:=True;
+    D.Draw;
+  finally
+    D.Free;
+  end;
+end;
+
+
+Procedure RegisterReportBarcode;
+
+begin
+  gElementFactory.RegisterClass('Barcode',TFPReportBarcode);
+  // Fallback renderer
+  gElementFactory.RegisterImageRenderer(TFPReportBarcode,@RenderBarcode);
+end;
+
+Procedure UnRegisterReportBarcode;
+
+begin
+  gElementFactory.RemoveClass('Barcode');
+end;
+
+initialization
+  RegisterReportBarcode;
+end.