|
@@ -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;
|
|
|
|
|
|
|