FastReport_FMX_2.8.12/Source/FMX.frxBarcode2DView.pas

{******************************************}
{                                          }
{           FastReport FMX v1.0            }
{        2D Barcode Add-in object          }
{                                          }
{         Copyright (c) 1998-2013          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}


unit FMX.frxBarcode2DView;

interface

{$I fmx.inc}
{$I frx.inc}
{$I fmx.inc}

uses
    System.SysUtils, System.Classes, System.UITypes, System.UIConsts,
    System.Types, FMX.Controls, FMX.Types, FMX.Objects, FMX.Forms, FMX.Dialogs,
    FMX.Menus, FMX.frxClass, FMX.frxdesgn, FMX.frxBarcodePDF417, FMX.frxBarcodeQR,
    FMX.frxBarcodeDataMatrix, FMX.frxBarcode2DBase, FMX.frxBarcodeProperties,
    System.Variants
{$IFDEF DELPHI19}
  , FMX.Graphics
{$ENDIF}
{$IFDEF DELPHI20}
  , System.Math.Vectors
{$ENDIF}
{$IFDEF DELPHI28}
  , FMX.BaseTypeAliases, FMX.FormTypeAliases
{$ENDIF};
type

  TfrxBarcodeType =
  (
      bc_datamatrix,
      bc_PDF417,
	  bcCodeQR
  );

{$I frxFMX_PlatformsAttribute.inc}
  Tfrx2DBarCodeObject = class(TComponent); // fake component

  TfrxBarcode2DView = class(TfrxView)
  private
    FBarCode: TfrxBarcode2DBase;
    FBarType: TfrxBarcodeType;
    FHAlign: TfrxHAlign;
    FProp : TUniqueProp;
	FExpression: String;
    procedure SetZoom(z: Double);
    function GetZoom : Double;
    procedure SetRotation(Value : Integer);
    function GetRotation: Integer;
    procedure SetShowText(Value: Boolean);
    function GetShowText: Boolean;
    procedure SetText(Value: String);
    function GetText: String;
    procedure SetFontScaled(Value: Boolean);
    function GetFontScaled: Boolean;
    procedure SetErrorText(Value: String);
    function GetErrorText: String;
    procedure SetQuiteZone(Value: Integer);
    function GetQuiteZone: Integer;
    procedure SetProp (Value: TUniqueProp);
    procedure SetBarType(Value: TfrxBarcodeType);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY : Extended); override;
    class function GetDescription: String; override;
    procedure GetData; override;
    property BarCode: TfrxBarcode2DBase read FBarCode write FBarcode;
  published
    property Expression: String read FExpression write FExpression;
    property BarType: TfrxBarcodeType read FBarType write SetBarType;
    property BarProperties : TUniqueProp read FProp write SetProp;
    property BrushStyle;
    property Color;
    property Cursor;
    property DataField;
    property DataSet;
    property DataSetName;
    property Frame;
    property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
    property Rotation: Integer read GetRotation write SetRotation;
    property ShowText: Boolean read GetShowText write SetShowText;
    property TagStr;
    property Text: String read GetText write SetText;
    property URL;
    property Zoom: Double read GetZoom write SetZoom;
    property Font;
    property FontScaled: Boolean read GetFontScaled write SetFontScaled;
    property ErrorText: String read GetErrorText write SetErrorText;
    property QuiteZone: Integer read GetQuiteZone write SetQuiteZone;
  end;

implementation

uses
{$IFNDEF NO_EDITORS}
//    frxBarcodeEditor,
{$ENDIF}
    FMX.frxBarcode2DRTTI, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils;

{ TfrxBarcode2DView }

constructor TfrxBarcode2DView.Create(AOwner: TComponent);
begin
  inherited;
  FBarCode := TfrxBarcodePDF417.Create;
  FBarType := bc_PDF417;
  Font.AssignToFont(FBarCode.Font);
  Width := 0;
  Height := 0;
  FProp := TPDF417UniqueProperties.Create;
  FProp.SetWhose(FBarcode);
end;

destructor TfrxBarcode2DView.Destroy;
begin
  FBarCode.Free;
  FProp.free;
  inherited Destroy;
end;

procedure TfrxBarcode2DView.SetProp (Value: TUniqueProp);
begin
  FProp.Assign(Value);
end;

procedure TfrxBarcode2DView.SetBarType(Value: TfrxBarcodeType);
var
  tmp: TfrxBarcode2DBase;
  aReport: TfrxReport;
begin
  if FBarType = Value then exit;
  tmp := TfrxBarcode2DBase.Create;
  tmp.Assign(FBarcode);
  try
    if Value = bc_PDF417 then
    begin
      FBarType := Value;
      FBarCode.Free;
      FBarCode := TfrxBarcodePDF417.Create;
      FBarcode.Assign(tmp);
      FBarcode.PixelWidth := FBarcode.PixelHeight div 4;
      if FBarcode.PixelWidth < 1 then FBarcode.PixelWidth := 1;
      FProp.Free;
      FProp := TPDF417UniqueProperties.create;
      FProp.SetWhose(FBarCode);
    end
    else if Value = bc_datamatrix then
    begin
      FBarType := Value;
      FBarCode.Free;
      FBarCode := TfrxBarcodeDataMatrix.Create;
      FBarCode.Assign(tmp);
      FBarCode.PixelWidth := FBarCode.PixelHeight;
      FProp.Free;
      FProp := TDataMatrixUniqueProperties.Create;
      FProp.SetWhose(FBarCode);
    end
    else if Value = bcCodeQR then
    begin
      FBarType := Value;
      FBarCode.Free;
      FBarCode := TfrxBarcodeQR.Create;
      FProp.Free;
      FProp := TfrxQRProperties.Create;
      FProp.SetWhose(FBarCode);
    end;
    aReport := Self.Report;
    if (aReport <> nil) and (aReport.Designer <> nil) then
      aReport.Designer.UpdateInspector;
  finally
    tmp.Free;
  end;
end;

procedure TfrxBarcode2DView.SetZoom(z: Double);
begin
  FBarcode.Zoom := z;
end;

function TfrxBarcode2DView.GetZoom: Double;
begin
  Result := FBarcode.Zoom;
end;

procedure TfrxBarcode2DView.SetRotation(Value: Integer);
begin
  FBarcode.Rotation := Value;
end;

function TfrxBarcode2DView.GetRotation: Integer;
begin
  Result := FBarcode.Rotation;
end;

procedure TfrxBarcode2DView.SetShowText(Value : Boolean);
begin
  FBarcode.ShowText := Value;
end;

function TfrxBarcode2DView.GetShowText : Boolean;
begin
  Result := FBarcode.ShowText;
end;

procedure TfrxBarcode2DView.SetText(Value: String);
begin
  FBarcode.Text := Value;
end;

function TfrxBarcode2DView.GetText: String;
begin
  Result := FBarcode.Text;
end;

procedure TfrxBarcode2DView.SetFontScaled(Value: Boolean);
begin
  FBarcode.FontScaled := Value;
end;

function TfrxBarcode2DView.GetFontScaled: Boolean;
begin
  Result := FBarcode.FontScaled;
end;

procedure TfrxBarcode2DView.SetErrorText(Value: String);
begin
  FBarcode.ErrorText := Value;
end;

function TfrxBarcode2DView.GetErrorText: String;
begin
  Result := FBarcode.ErrorText;
end;

procedure TfrxBarcode2DView.SetQuiteZone(Value : Integer);
begin
  FBarcode.QuiteZone := Value;
end;

function TfrxBarcode2DView.GetQuiteZone: Integer;
begin
  Result := FBarcode.QuiteZone;
end;

procedure TfrxBarcode2DView.GetData;
begin
  inherited;
  if IsDataField then
    FBarcode.Text := VarToStr(DataSet.Value[DataField])
  else if FExpression <> '' then
    FBarcode.Text := VarToStr(Report.Calc(FExpression));
end;

class function TfrxBarcode2DView.GetDescription: String;
begin
  Result := frxResources.Get('2D Barcode');
end;

procedure TfrxBarcode2DView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
var
  w, h, tmp: Extended;
  scaledFontCorrX, scaledFontCorrY: Integer;
  DrawRectA: TRectF;
begin
  case Round(Rotation) of
    0 .. 44:    Rotation := 0;
    45 .. 135:  Rotation := 90;
    136 .. 224: Rotation := 180;
    225 .. 315: Rotation := 270;
  else
    Rotation := 0;
  end;

  Font.AssignToFont(FBarCode.Font);
  FBarCode.FontColor := Font.Color;

  if Color = claNull then
    FBarCode.Color := claWhite
  else
    FBarCode.Color := Color;

  w := FBarCode.Width;
  h := FBarCode.Height;



  if FontScaled or (not ShowText) then
  begin
    scaledFontCorrX := 0;
    scaledFontCorrY := 0;
  end
  else
  begin
    scaledFontCorrY := FBarCode.GetFooterHeight;
    scaledFontCorrX := 0;
    if (Rotation = 90) or (Rotation = 270) then
    begin
      scaledFontCorrX := FBarCode.GetFooterHeight;
      scaledFontCorrY := 0;
    end;
  end;

  if (Rotation = 90) or (Rotation = 270) then
  begin
    tmp := w;
    w := h;
    h := tmp;
  end;

  Height := (h - scaledFontCorrY) * Zoom + scaledFontCorrY;
  Width := (w - scaledFontCorrX)  * Zoom + scaledFontCorrX;
  if Frame.DropShadow then
  begin
    Height := Height + round(Frame.ShadowWidth);
    Width := Width +  round(Frame.ShadowWidth);
  end;

  BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);

  if FBarcode.ErrorText <> '' then
  begin
    with Canvas do
    begin
      Font.Family := 'Arial';
      Font.Size := Round(8 * ScaleY);
      Fill.Color := claRed;
      Stroke.Color := claBlack;
      DrawRectA := RectF(FX + 2, FY + 2, FX1, FY1);
      FillText(DrawRectA, ErrorText, True, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
      Exit;
    end;
  end;

  DrawBackground;
  FBarCode.Draw2DBarcode(Canvas, FScaleX, FScaleY, FX, FY, IsPrinting);
  DrawFrame;
end;

initialization
  StartClassGroup(TFmxObject);
  ActivateClassGroup(TFmxObject);
  GroupDescendentsWith(TfrxBarcode2DView, TFmxObject);
  GroupDescendentsWith(Tfrx2DBarCodeObject, TFmxObject);
  frxObjects.RegisterObject1(TfrxBarcode2DView, nil, '', '', 0, 123);

finalization
  frxObjects.Unregister(TfrxBarcode2DView);


end.