Browse Source

* Refactoring and added copyright

git-svn-id: trunk@37307 -
michael 8 years ago
parent
commit
e6daa40259
1 changed files with 204 additions and 33 deletions
  1. 204 33
      packages/fcl-image/src/fpimgbarcode.pp

+ 204 - 33
packages/fcl-image/src/fpimgbarcode.pp

@@ -1,3 +1,18 @@
+{
+    This file is part of the Free Pascal FCL library.
+    Copyright (c) 2017 by Michael Van Canneyt
+    member of the Free Pascal development team
+
+    Barcode drawing routines.
+
+    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 fpimgbarcode;
 
 {$mode objfpc}{$H+}
@@ -7,6 +22,56 @@ interface
 uses
   Classes, SysUtils, fpcanvas, fpimage, types, fpbarcode;
 
+Type
+  // So people don't need to include fpBarcode
+  TBarcodeEncoding = fpbarcode.TBarcodeEncoding;
+
+  { TFPDrawBarCode }
+
+  TFPDrawBarCode = Class
+  private
+    FCanvas: TFPCustomCanvas;
+    FEncoding: TBarcodeEncoding;
+    FImage: TFPCustomImage;
+    FRect: TRect;
+    FText: String;
+    FUnitWidth: Integer;
+    FWeight: Double;
+    FFreeCanvas : Boolean;
+    FWidths : TBarWidthArray;
+    procedure SetCanvas(AValue: TFPCustomCanvas);
+    procedure SetEncoding(AValue: TBarcodeEncoding);
+    procedure SetImage(AValue: TFPCustomImage);
+    procedure SetUnitWidth(AValue: Integer);
+    procedure SetWeight(AValue: Double);
+  Protected
+    procedure CheckFreeCanvas;
+    Procedure CalcWidths; virtual;
+    Property FreeCanvas : Boolean Read FFreeCanvas Write FFreeCanvas;
+  Public
+    Constructor Create; virtual;
+    Destructor Destroy; override;
+    procedure CheckCanvas; virtual;
+    // Returns true if the text was drawn, false if not.
+    Function Draw : Boolean; virtual;
+    // Returns true if the text can be drawn using current encoding, false if not
+    Function AllowDraw : Boolean;
+    // Informational: calc width of text using current parameters. -1 if the text cannot be drawn.
+    Function CalcWidth : Integer;
+    // One of Image or Canvas must be set.
+    Property Image : TFPCustomImage Read FImage Write SetImage;
+    Property Canvas : TFPCustomCanvas Read FCanvas Write SetCanvas;
+    // Rectangle in which to draw
+    Property Rect : TRect Read FRect Write FRect;
+    // Unit width of a bar
+    Property UnitWidth : Integer Read FUnitWidth Write SetUnitWidth;
+    // Weight to use when calculating bar widths.
+    Property Weight : Double Read FWeight Write SetWeight;
+    // Encoding to use
+    Property Encoding : TBarcodeEncoding Read FEncoding Write SetEncoding;
+    // Text to draw.
+    Property Text : String Read FText Write FText;
+  end;
 
 Function DrawBarCode(Img : TFPCustomImage; S : String; E : TBarcodeEncoding; aWidth : Integer = 1; AWeight : Double = 2.0) : Boolean;
 Function DrawBarCode(Img : TFPCustomImage; Rect : TRect; S : String; E : TBarcodeEncoding; aWidth : Integer = 1; AWeight : Double = 2.0) : Boolean;
@@ -32,8 +97,100 @@ end;
 Function DrawBarCode(Img : TFPCustomImage; Rect : TRect; S : String; E : TBarcodeEncoding; aWidth : Integer = 1; AWeight : Double = 2.0) : Boolean;
 
 Var
-  Cnv : TFPImageCanvas;
-  BWT : TBarWidthArray;
+  DBC : TFPDrawBarCode;
+
+begin
+  DBC:=TFPDrawBarCode.Create;
+  try
+    DBC.Rect:=Rect;
+    DBC.UnitWidth:=aWidth;
+    DBC.Weight:=aWeight;
+    DBC.Encoding:=E;
+    DBC.Text:=S;
+    DBC.Image:=Img;
+    Result:=DBC.Draw;
+  finally
+    DBC.Free;
+  end;
+end;
+{ TFPDrawBarCode }
+procedure TFPDrawBarCode.CheckFreeCanvas;
+
+begin
+  if FFreeCanvas then
+    FreeAndNil(FCanvas)
+  else
+    FCanvas:=Nil;
+end;
+
+procedure TFPDrawBarCode.SetImage(AValue: TFPCustomImage);
+begin
+  if FImage=AValue then Exit;
+  FImage:=AValue;
+  CheckFreeCanvas;
+end;
+
+procedure TFPDrawBarCode.SetUnitWidth(AValue: Integer);
+begin
+  if FUnitWidth=AValue then Exit;
+  FUnitWidth:=AValue;
+  CalcWidths;
+end;
+
+procedure TFPDrawBarCode.SetWeight(AValue: Double);
+begin
+  if FWeight=AValue then Exit;
+  FWeight:=AValue;
+  CalcWidths;
+end;
+
+procedure TFPDrawBarCode.CalcWidths;
+begin
+  FWidths:=CalcBarWidths(FEncoding,UnitWidth,Weight);
+end;
+
+procedure TFPDrawBarCode.SetCanvas(AValue: TFPCustomCanvas);
+begin
+  if FCanvas=AValue then Exit;
+  CheckFreeCanvas;
+  FCanvas:=AValue;
+end;
+
+procedure TFPDrawBarCode.SetEncoding(AValue: TBarcodeEncoding);
+begin
+  if FEncoding=AValue then Exit;
+  FEncoding:=AValue;
+  CalcWidths;
+end;
+
+constructor TFPDrawBarCode.Create;
+begin
+  FUnitWidth:=1;
+  FWeight:=2.0;
+  FEncoding:=beEAN8;
+  CalcWidths;
+end;
+
+Destructor TFPDrawBarCode.Destroy;
+
+begin
+  CheckFreeCanvas;
+end;
+
+procedure TFPDrawBarCode.CheckCanvas;
+
+begin
+  if (FCanvas=Nil) then
+    begin
+    FCanvas:=TFPImageCanvas.create(FImage);
+    FFreeCanvas:=True;
+    end;
+end;
+
+Function TFPDrawBarCode.Draw : Boolean;
+
+Var
+  Cnv : TFPCustomCanvas;
   i: integer;
   xOffset: integer;
   w, h: integer;
@@ -42,37 +199,51 @@ Var
   Data : TBarTypeArray;
 
 begin
-  BWT:=CalcBarWidths(E,aWidth,aWeight);
-  Data:=StringToBarTypeArray(S,E);
-  Cnv:=TFPImageCanvas.Create(Img);
-  try
-    xOffset := 0;
-    Cnv.Brush.FPColor := colWhite;
-    Cnv.Brush.Style:=bsSolid;
-    Cnv.FillRect(Rect);
-    Cnv.Pen.Width := 1;
-    for i:=0 to Length(Data)-1 do
-      begin
-      BP:=BarTypeToBarParams(Data[i]);
-      case BP.c of
-        bcBlack : Cnv.Pen.FPColor := colBlack;
-        bcWhite : Cnv.Pen.FPColor := colWhite;
-      end;
-      W:=BWT[BP.w];
-      Cnv.Brush.FPColor:=Cnv.Pen.FPColor;
-      H:=Rect.Bottom-Rect.Top;
-      if BP.h=bhTwoFifth then
-        H:=H*2 div 5;
-      BarRect.Left:=Rect.Left+xOffset;
-      BarRect.Top:=Rect.Top;
-      BarRect.Bottom:=Rect.Top+H;
-      BarRect.Right:=BarRect.Left + W-1;
-      Cnv.FillRect(BarRect);
-      xOffset:=xOffset + W;
-      end;
-  finally
-    Cnv.Free;
-  end;
+  Result:=AllowDraw;
+  if not Result then
+    exit;
+  CheckCanvas;
+  Cnv:=FCanvas;
+  Data:=StringToBarTypeArray(Text,FEncoding);
+  xOffset := 0;
+  Cnv.Brush.FPColor := colWhite;
+  Cnv.Brush.Style:=bsSolid;
+  Cnv.FillRect(Rect);
+  Cnv.Pen.Width := 1;
+  for i:=0 to Length(Data)-1 do
+    begin
+    BP:=BarTypeToBarParams(Data[i]);
+    case BP.c of
+      bcBlack : Cnv.Pen.FPColor := colBlack;
+      bcWhite : Cnv.Pen.FPColor := colWhite;
+    end;
+    W:=FWidths[BP.w];
+    Cnv.Brush.FPColor:=Cnv.Pen.FPColor;
+    H:=Rect.Bottom-Rect.Top;
+    if BP.h=bhTwoFifth then
+      H:=H*2 div 5;
+    BarRect.Left:=Rect.Left+xOffset;
+    BarRect.Top:=Rect.Top;
+    BarRect.Bottom:=Rect.Top+H;
+    BarRect.Right:=BarRect.Left + W-1;
+    Cnv.FillRect(BarRect);
+    xOffset:=xOffset + W;
+    end;
+end;
+
+function TFPDrawBarCode.AllowDraw: Boolean;
+
+begin
+  Result:=StringAllowsBarEncoding(FText,FEncoding);
+end;
+
+function TFPDrawBarCode.CalcWidth: Integer;
+
+begin
+  if AllowDraw then
+    Result:=CalcStringWidthInBarCodeEncoding(FText,FEncoding,UnitWidth,Weight)
+  else
+    Result:=-1;
 end;