469 lines
12 KiB
ObjectPascal
469 lines
12 KiB
ObjectPascal
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastReport FMX v1.0 }
|
||
|
|
{ 2D Barcode Add-in object }
|
||
|
|
{ }
|
||
|
|
{ Copyright (c) 1998-2013 }
|
||
|
|
{ by Alexander Tzyganenko, }
|
||
|
|
{ Fast Reports Inc. }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
unit FMX.frxBarcode2DBase;
|
||
|
|
{$I frx.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
System.Classes,
|
||
|
|
System.SysUtils,
|
||
|
|
System.Types,
|
||
|
|
System.UITypes,
|
||
|
|
System.UIConsts,
|
||
|
|
System.Math,
|
||
|
|
FMX.Types,
|
||
|
|
FMX.Objects,
|
||
|
|
FMX.frxPrinter
|
||
|
|
{$IFDEF DELPHI19}
|
||
|
|
, FMX.Graphics, FMX.frxFMX
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF DELPHI20}
|
||
|
|
, System.Math.Vectors
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF DELPHI28}
|
||
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
||
|
|
{$ENDIF};
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
TfrxBarcode2DBase = class(TComponent)
|
||
|
|
protected
|
||
|
|
FImage: TBytes;
|
||
|
|
FHeight: Integer;
|
||
|
|
FWidth: Integer;
|
||
|
|
FPixelWidth: Integer;
|
||
|
|
FPixelHeight: Integer;
|
||
|
|
FShowText: boolean;
|
||
|
|
FRotation: Integer;
|
||
|
|
FText: String;
|
||
|
|
FZoom: Double;
|
||
|
|
FFontScaled: boolean;
|
||
|
|
FFont: TFont;
|
||
|
|
FColor: TAlphaColor;
|
||
|
|
FColorBar: TAlphaColor;
|
||
|
|
FFontColor: TAlphaColor;
|
||
|
|
FErrorText: String;
|
||
|
|
FQuiteZone: Integer;
|
||
|
|
|
||
|
|
procedure SetShowText(Value: boolean); virtual;
|
||
|
|
procedure SetRotation(Value: Integer); virtual;
|
||
|
|
procedure SetText(Value: String); virtual;
|
||
|
|
procedure SetZoom(Value: Double); virtual;
|
||
|
|
procedure SetFontScaled(Value: boolean); virtual;
|
||
|
|
procedure SetFont(Value: TFont); virtual;
|
||
|
|
procedure SetColor(Value: TAlphaColor); virtual;
|
||
|
|
procedure SetColorBar(Value: TAlphaColor); virtual;
|
||
|
|
procedure SetErrorText(Value: String); virtual;
|
||
|
|
function GetWidth: Integer; virtual;
|
||
|
|
function GetHeight: Integer; virtual;
|
||
|
|
public
|
||
|
|
constructor Create; reintroduce; virtual;
|
||
|
|
destructor Destroy; override;
|
||
|
|
procedure Assign(Source: TfrxBarcode2DBase); reintroduce; virtual;
|
||
|
|
function GetFooterHeight: Integer; virtual;
|
||
|
|
procedure Draw2DBarcode(var Canvas: TCanvas; scalex, scaley: extended;
|
||
|
|
x, y: Integer; IsPrinting: boolean = False); virtual;
|
||
|
|
|
||
|
|
property ShowText: boolean read FShowText write SetShowText;
|
||
|
|
property Rotation: Integer read FRotation write SetRotation;
|
||
|
|
property Text: String read FText write SetText;
|
||
|
|
property Zoom: Double read FZoom write SetZoom;
|
||
|
|
property FontScaled: boolean read FFontScaled write SetFontScaled;
|
||
|
|
property Font: TFont read FFont write SetFont;
|
||
|
|
property Color: TAlphaColor read FColor write SetColor;
|
||
|
|
property FontColor: TAlphaColor read FFontColor write FFontColor;
|
||
|
|
property ColorBar: TAlphaColor read FColorBar write SetColorBar;
|
||
|
|
property ErrorText: String read FErrorText write SetErrorText;
|
||
|
|
property Width: Integer read GetWidth;
|
||
|
|
property Height: Integer read GetHeight;
|
||
|
|
property PixelWidth: Integer read FPixelWidth write FPixelWidth;
|
||
|
|
property PixelHeight: Integer read FPixelHeight write FPixelHeight;
|
||
|
|
property QuiteZone: Integer read FQuiteZone write FQuiteZone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
const
|
||
|
|
cbDefaultText = '12345678';
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
constructor TfrxBarcode2DBase.Create;
|
||
|
|
begin
|
||
|
|
FWidth := 0;
|
||
|
|
FHeight := 0;
|
||
|
|
FImage := nil;
|
||
|
|
FPixelWidth := 2;
|
||
|
|
FPixelHeight := 2;
|
||
|
|
FShowText := true;
|
||
|
|
FRotation := 0;
|
||
|
|
FText := cbDefaultText;
|
||
|
|
FZoom := 1;
|
||
|
|
FFontScaled := true;
|
||
|
|
FColor := claWhite;
|
||
|
|
FColorBar := claBlack;
|
||
|
|
FFontColor := claBlack;
|
||
|
|
FFont := TFont.Create;
|
||
|
|
FFont.Family := 'Arial';
|
||
|
|
FFont.Size := 9;
|
||
|
|
FQuiteZone := 3;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.Assign(Source: TfrxBarcode2DBase);
|
||
|
|
begin
|
||
|
|
FShowText := Source.FShowText;
|
||
|
|
FRotation := Source.FRotation;
|
||
|
|
FText := Source.FText;
|
||
|
|
FZoom := Source.FZoom;
|
||
|
|
FPixelWidth := Source.FPixelWidth;
|
||
|
|
FPixelHeight := Source.FPixelHeight;
|
||
|
|
FFontScaled := Source.FFontScaled;
|
||
|
|
FFont.Assign(Source.FFont);
|
||
|
|
FColor := Source.FColor;
|
||
|
|
FColorBar := Source.FColorBar;
|
||
|
|
FErrorText := Source.FErrorText;
|
||
|
|
FQuiteZone := Source.FQuiteZone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetShowText(Value: boolean);
|
||
|
|
begin
|
||
|
|
FShowText := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetRotation(Value: Integer);
|
||
|
|
begin
|
||
|
|
FRotation := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetText(Value: String);
|
||
|
|
begin
|
||
|
|
if (FText <> Value) then
|
||
|
|
FText := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetZoom(Value: Double);
|
||
|
|
begin
|
||
|
|
FZoom := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetFontScaled(Value: boolean);
|
||
|
|
begin
|
||
|
|
FFontScaled := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetFont(Value: TFont);
|
||
|
|
begin
|
||
|
|
FFont.Assign(Value);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetColor(Value: TAlphaColor);
|
||
|
|
begin
|
||
|
|
FColor := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetColorBar(Value: TAlphaColor);
|
||
|
|
begin
|
||
|
|
FColorBar := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.SetErrorText(Value: String);
|
||
|
|
begin
|
||
|
|
FErrorText := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxBarcode2DBase.GetFooterHeight: Integer;
|
||
|
|
begin
|
||
|
|
result := Round(Font.Size * 96 / 72) * 2 div 4;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxBarcode2DBase.GetWidth: Integer;
|
||
|
|
begin
|
||
|
|
result := Round(FWidth * FPixelWidth + FQuiteZone * 2);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxBarcode2DBase.GetHeight: Integer;
|
||
|
|
begin
|
||
|
|
if FShowText then
|
||
|
|
result := Round(FHeight * FPixelHeight + Round(Font.Size * 96 / 72 * 2) / 4
|
||
|
|
+ FQuiteZone * 2)
|
||
|
|
else
|
||
|
|
result := Round(FHeight * FPixelHeight + FQuiteZone * 2);
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TfrxBarcode2DBase.Destroy;
|
||
|
|
begin
|
||
|
|
FreeAndNil(FFont);
|
||
|
|
SetLength(FImage, 0);
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxBarcode2DBase.Draw2DBarcode(var Canvas: TCanvas;
|
||
|
|
scalex, scaley: extended; x, y: Integer; IsPrinting: boolean = False);
|
||
|
|
var
|
||
|
|
stride, p, k, j, b: Integer;
|
||
|
|
dx, dy, textLeftOffset, textSemiLength, footerHeight, saveFooter, paddingX,
|
||
|
|
paddingY, x1, y1, x2, y2, txtX, txtY, e: Single;
|
||
|
|
kx, ky, saveKX, saveKY: extended;
|
||
|
|
// flag: boolean;
|
||
|
|
bmp: TBitmap;
|
||
|
|
r, TextRect: TRectF;
|
||
|
|
state: TCanvasSaveState;
|
||
|
|
m, OldM: TMatrix;
|
||
|
|
|
||
|
|
begin
|
||
|
|
kx := scalex * Zoom;
|
||
|
|
ky := scaley * Zoom;
|
||
|
|
x1 := 0;
|
||
|
|
x2 := 0;
|
||
|
|
y1 := 0;
|
||
|
|
y2 := 0;
|
||
|
|
footerHeight := 0;
|
||
|
|
dy := Round(FHeight * PixelHeight * ky);
|
||
|
|
dx := Round(FWidth * PixelWidth * kx);
|
||
|
|
paddingX := Round(FQuiteZone * kx);
|
||
|
|
paddingY := Round(FQuiteZone * ky);
|
||
|
|
|
||
|
|
if ShowText then
|
||
|
|
begin
|
||
|
|
Canvas.Font.Assign(FFont);
|
||
|
|
|
||
|
|
|
||
|
|
// Canvas.Font.Size := Canvas.Font.Size * ScaleY;
|
||
|
|
|
||
|
|
textSemiLength := Canvas.TextWidth(Text) / 2;
|
||
|
|
footerHeight := (Round(Font.Size * 96 / 72) + 4) * Zoom * scaley;
|
||
|
|
// + Round(Font.Size * 96 / 72);
|
||
|
|
if not IsPrinting then
|
||
|
|
Canvas.Font.Size := (FFont.Size * Zoom * scaley);
|
||
|
|
|
||
|
|
case Round(Rotation) of
|
||
|
|
0:
|
||
|
|
begin
|
||
|
|
x1 := x;
|
||
|
|
y1 := y + dy;
|
||
|
|
x2 := x + dx;
|
||
|
|
y2 := y + dy + footerHeight;
|
||
|
|
textLeftOffset := dx / 2 - textSemiLength;
|
||
|
|
if textLeftOffset < 0 then
|
||
|
|
textLeftOffset := 0;
|
||
|
|
txtX := x + textLeftOffset;
|
||
|
|
txtY := y + dy
|
||
|
|
end;
|
||
|
|
90:
|
||
|
|
begin
|
||
|
|
x1 := x + dy;
|
||
|
|
x2 := x + dy + footerHeight;
|
||
|
|
y1 := y;
|
||
|
|
y2 := y + dx;
|
||
|
|
textLeftOffset := dx / 2 - textSemiLength;
|
||
|
|
if textLeftOffset < 0 then
|
||
|
|
textLeftOffset := 0;
|
||
|
|
txtX := x1;
|
||
|
|
txtY := y2 - textLeftOffset;
|
||
|
|
end;
|
||
|
|
180:
|
||
|
|
begin
|
||
|
|
x1 := x;
|
||
|
|
x2 := x + dx;
|
||
|
|
y1 := y;
|
||
|
|
y2 := y + footerHeight;
|
||
|
|
textLeftOffset := dx / 2 - textSemiLength;
|
||
|
|
if textLeftOffset < 0 then
|
||
|
|
textLeftOffset := 0;
|
||
|
|
txtX := x + dx - textLeftOffset;
|
||
|
|
txtY := y + footerHeight;
|
||
|
|
end;
|
||
|
|
270:
|
||
|
|
begin
|
||
|
|
x1 := x;
|
||
|
|
x2 := x + footerHeight;
|
||
|
|
y1 := y;
|
||
|
|
y2 := y + dx;
|
||
|
|
textLeftOffset := dx / 2 - textSemiLength;
|
||
|
|
if textLeftOffset < 0 then
|
||
|
|
textLeftOffset := 0;
|
||
|
|
txtX := x1 + footerHeight;
|
||
|
|
txtY := y1 + textLeftOffset;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
OldM := Canvas.Matrix;
|
||
|
|
state := Canvas.SaveState;
|
||
|
|
try
|
||
|
|
TextRect := RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
|
||
|
|
y2 + paddingY);
|
||
|
|
if FRotation > 0 then
|
||
|
|
begin
|
||
|
|
m := CreateRotationMatrix(-DegToRad(FRotation));
|
||
|
|
m.m31 := OldM.m31 + TextRect.Left + TextRect.Width / 2;
|
||
|
|
m.m32 := OldM.m32 + TextRect.Top + TextRect.Height / 2;
|
||
|
|
Canvas.SetMatrix(m);
|
||
|
|
|
||
|
|
e := TextRect.Width;
|
||
|
|
TextRect.Left := -TextRect.Width / 2;
|
||
|
|
TextRect.Right := TextRect.Left + e;
|
||
|
|
e := TextRect.Height;
|
||
|
|
TextRect.Top := -TextRect.Height / 2;
|
||
|
|
TextRect.Bottom := TextRect.Top + e;
|
||
|
|
|
||
|
|
if ((FRotation >= 90) and (FRotation < 180)) or
|
||
|
|
((FRotation >= 270) and (FRotation < 360)) then
|
||
|
|
TextRect := RectF(TextRect.Top, TextRect.Left, TextRect.Bottom,
|
||
|
|
TextRect.Right);
|
||
|
|
end;
|
||
|
|
Canvas.Fill.Color := FFontColor;
|
||
|
|
Canvas.FillText(TextRect, Text, False, 1, [], TTextAlign.taCenter,
|
||
|
|
TTextAlign.taLeading);
|
||
|
|
|
||
|
|
finally
|
||
|
|
Canvas.RestoreState(state);
|
||
|
|
Canvas.SetMatrix(OldM);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
stride := (FWidth + 7) div 8;
|
||
|
|
|
||
|
|
saveKX := 0;
|
||
|
|
bmp := nil;
|
||
|
|
if (kx < 1) or (ky < 1) then
|
||
|
|
begin
|
||
|
|
saveKX := kx;
|
||
|
|
saveKY := ky;
|
||
|
|
saveFooter := footerHeight;
|
||
|
|
kx := 1;
|
||
|
|
ky := 1;
|
||
|
|
footerHeight := 0;
|
||
|
|
bmp := TBitmap.Create(FWidth * PixelWidth, FHeight * PixelHeight);
|
||
|
|
if (Rotation = 90) or (Rotation = 270) then
|
||
|
|
begin
|
||
|
|
bmp.Height := FWidth * PixelWidth;
|
||
|
|
bmp.Width := FHeight * PixelHeight;
|
||
|
|
end;
|
||
|
|
dy := Round(FHeight * PixelHeight);
|
||
|
|
dx := Round(FWidth * PixelWidth);
|
||
|
|
bmp.Canvas.BeginScene();
|
||
|
|
end;
|
||
|
|
try
|
||
|
|
|
||
|
|
for k := 0 to FHeight - 1 do
|
||
|
|
begin
|
||
|
|
p := k * stride;
|
||
|
|
for j := 0 to FWidth - 1 do
|
||
|
|
begin
|
||
|
|
b := FImage[p + (j div 8)] and $FF;
|
||
|
|
b := b shl (j mod 8);
|
||
|
|
|
||
|
|
if (b and $80) = 0 then
|
||
|
|
begin
|
||
|
|
if (saveKX <> 0) then
|
||
|
|
bmp.Canvas.Fill.Color := claWhite
|
||
|
|
else
|
||
|
|
Canvas.Fill.Color := claWhite;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if (saveKX <> 0) then
|
||
|
|
bmp.Canvas.Fill.Color := claBlack
|
||
|
|
else
|
||
|
|
Canvas.Fill.Color := claBlack;
|
||
|
|
end;
|
||
|
|
|
||
|
|
case Round(Rotation) of
|
||
|
|
0:
|
||
|
|
begin
|
||
|
|
x1 := Round(x + j * PixelWidth * kx);
|
||
|
|
y1 := Round(y + k * PixelHeight * ky);
|
||
|
|
x2 := Round(x + j * PixelWidth * kx + PixelWidth * kx);
|
||
|
|
y2 := Round(y + k * PixelHeight * ky + PixelHeight * ky);
|
||
|
|
end;
|
||
|
|
90:
|
||
|
|
begin
|
||
|
|
x1 := Round(x + k * PixelHeight * kx);
|
||
|
|
x2 := Round(x + k * PixelHeight * kx + PixelHeight * kx);
|
||
|
|
y1 := Round(y + dx - j * PixelWidth * ky);
|
||
|
|
y2 := Round(y + dx - j * PixelWidth * ky - PixelWidth * ky);
|
||
|
|
end;
|
||
|
|
180:
|
||
|
|
begin
|
||
|
|
x1 := Round(x + dx - j * PixelWidth * kx);
|
||
|
|
x2 := Round(x + dx - j * PixelWidth * kx - PixelWidth * kx);
|
||
|
|
y1 := Round(y + footerHeight + dy - k * PixelHeight * ky);
|
||
|
|
y2 := Round(y + footerHeight + dy - k * PixelHeight * ky -
|
||
|
|
PixelHeight * ky);
|
||
|
|
end;
|
||
|
|
270:
|
||
|
|
begin
|
||
|
|
x1 := Round(x + footerHeight + dy - k * PixelHeight * kx);
|
||
|
|
x2 := Round(x + footerHeight + dy - k * PixelHeight * kx -
|
||
|
|
PixelHeight * kx);
|
||
|
|
y1 := Round(y + j * PixelWidth * ky);
|
||
|
|
y2 := Round(y + j * PixelWidth * ky + PixelWidth * ky);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
if (saveKX = 0) then
|
||
|
|
Canvas.FillRect(RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
|
||
|
|
y2 + paddingY), 0, 0, allCorners, 1)
|
||
|
|
else
|
||
|
|
bmp.Canvas.FillRect(RectF(x1 - x + paddingX, y1 - y + paddingY,
|
||
|
|
x2 - x + paddingX, y2 - y + paddingY), 0, 0, allCorners, 1);
|
||
|
|
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
if (saveKX <> 0) then
|
||
|
|
begin
|
||
|
|
bmp.Canvas.EndScene;
|
||
|
|
case Round(Rotation) of
|
||
|
|
0:
|
||
|
|
begin
|
||
|
|
x1 := 0;
|
||
|
|
y1 := 0;
|
||
|
|
x2 := Round(FWidth * PixelWidth * saveKX);
|
||
|
|
y2 := Round(FHeight * PixelHeight * saveKY);
|
||
|
|
end;
|
||
|
|
90:
|
||
|
|
begin
|
||
|
|
x1 := 0;
|
||
|
|
y1 := 0;
|
||
|
|
x2 := Round(FHeight * PixelHeight * saveKY);
|
||
|
|
y2 := Round(FWidth * PixelWidth * saveKX);
|
||
|
|
end;
|
||
|
|
180:
|
||
|
|
begin
|
||
|
|
x1 := 0;
|
||
|
|
y1 := saveFooter;
|
||
|
|
x2 := Round(FWidth * PixelWidth * saveKX);
|
||
|
|
y2 := Round(FHeight * PixelHeight * saveKY);
|
||
|
|
end;
|
||
|
|
270:
|
||
|
|
begin
|
||
|
|
x1 := saveFooter;
|
||
|
|
y1 := 0;
|
||
|
|
x2 := Round(FHeight * PixelHeight * saveKY);
|
||
|
|
y2 := Round(FWidth * PixelWidth * saveKX);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
r := RectF(x, y, x + x1 + x2 + paddingX, y + y1 + y2 + paddingY);
|
||
|
|
Canvas.DrawBitmap(bmp, RectF(0, 0, bmp.Width, bmp.Height), r, 1, False);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
if Assigned(bmp) then
|
||
|
|
FreeAndNil(bmp);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|