
{******************************************}
{                                          }
{             FastReport v5.0              }
{                 QR code                  }
{                                          }
{         Copyright (c) 1998-2014          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxBarcodeQR;


interface

{$I frx.inc}

uses
{$IFDEF FPC}
  LCLType, LMessages, LazHelper, LCLIntf,
{$ELSE}
  Windows, Messages,
{$ENDIF}
  SysUtils, Types, StrUtils, Classes, Graphics, Controls, Forms, Dialogs, frxBarcode2DBase, frxDelphiZXingQRCode;

type
  TfrxBarcodeLogo = class(TPersistent)
  private
    FLogo: TPicture;
    FWidth: Integer;
    FHeight: Integer;
    procedure SetLogo(const Value: TPicture);
    function GetLogo: TPicture;
    function GetLogoInst: TPicture;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Draw(DrawRect: TRect; ScaleX, ScaleY: Extended; Canvas: TCanvas; Zoom: Extended);
  published
    property Logo: TPicture read GetLogo write SetLogo;
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
  end;

  TfrxBarcodeQR = class( TfrxBarcode2DBaseWithUnion )
  private
    FDelphiZXingQRCode: TDelphiZXingQRCode;
    FLogo: TfrxBarcodeLogo;
    procedure Generate();
    function GetEncoding: TQRCodeEncoding;
    function GetQuietZone: Integer;
    procedure SetEncoding(const Value: TQRCodeEncoding);
    procedure SetQuietZone(const Value: Integer);
    function GetErrorLevels: TQRErrorLevels;
    procedure SetErrorLevels(const Value: TQRErrorLevels);
    function  GetPixelSize : integer;
    procedure SetPixelSize(v : integer);
    function GetCodepage: Longint;
    procedure SetCodepage(const Value: Longint);
  protected
    procedure SetText( v : string ); override;
  public
    constructor Create; override;
    destructor  Destroy; override;
    procedure   Assign(src: TfrxBarcode2DBase);override;
    procedure Draw2DBarcode(var g: TCanvas; scalex, scaley: Extended;
      x, y: Integer); override;
  published
     property Encoding: TQRCodeEncoding read GetEncoding write SetEncoding;
     property QuietZone: Integer read GetQuietZone write SetQuietZone;
     property ErrorLevels: TQRErrorLevels read GetErrorLevels write SetErrorLevels;
     property PixelSize : integer read GetPixelSize write SetPixelSize;
     property Codepage : Longint read GetCodepage write SetCodepage;
     property Logo: TfrxBarcodeLogo read FLogo;
  end;


implementation


{ TfrxBarcodeQR }

procedure TfrxBarcodeQR.Assign(src: TfrxBarcode2DBase);
var
   BSource : TfrxBarcodeQR;
begin
   inherited;
   if src is TfrxBarcodeQR then
   begin
      BSource    := TfrxBarcodeQR( src );
      FHeight    := BSource.FHeight;
      Encoding := BSource.Encoding;
      QuietZone := BSource.QuietZone;
      ErrorLevels := BSource.ErrorLevels;
   end;
end;

constructor TfrxBarcodeQR.Create;
begin
  inherited;
  FLogo := TfrxBarcodeLogo.Create;
  FDelphiZXingQRCode := TDelphiZXingQRCode.Create;
  FDelphiZXingQRCode.Data := FText;
  PixelWidth := 4;
  PixelHeight := 4;
  QuietZone := 0;
  Generate;
end;

destructor TfrxBarcodeQR.Destroy;
begin
  FDelphiZXingQRCode.Free;
  FreeAndNil(FLogo);
  inherited;
end;

procedure TfrxBarcodeQR.Draw2DBarcode(var g: TCanvas; scalex, scaley: Extended;
  x, y: Integer);
var
  drawR: TRect;
begin
  inherited;
  if ShowText then
    drawR := Rect(X, Y, X + Width, Y + Height - GetFooterHeight)
  else
    drawR := Rect(X, Y, X + Width, Y + Height);
  FLogo.Draw(drawR, scalex, scaley, g, Zoom);
end;

procedure TfrxBarcodeQR.Generate;
begin
    FHeight := FDelphiZXingQRCode.Rows;
    FWidth := FDelphiZXingQRCode.Columns;
    T2DBooleanArrayToVectorPrimitives(FDelphiZXingQRCode.FElements, FHeight, FWidth, FDelphiZXingQRCode.QuietZone);
end;

function TfrxBarcodeQR.GetCodepage: Longint;
begin
  Result := FDelphiZXingQRCode.CodePage;
end;

function TfrxBarcodeQR.GetEncoding: TQRCodeEncoding;
begin
  Result := FDelphiZXingQRCode.Encoding;
end;

function TfrxBarcodeQR.GetErrorLevels: TQRErrorLevels;
begin
  Result := FDelphiZXingQRCode.ErrorLevels;
end;

function TfrxBarcodeQR.GetQuietZone: Integer;
begin
  Result := FDelphiZXingQRCode.QuietZone;
end;

procedure TfrxBarcodeQR.SetCodepage(const Value: Longint);
begin
  FDelphiZXingQRCode.CodePage := Value;
end;

procedure TfrxBarcodeQR.SetEncoding(const Value: TQRCodeEncoding);
begin
  FDelphiZXingQRCode.Encoding := Value;
  Generate;
end;

procedure TfrxBarcodeQR.SetErrorLevels(const Value: TQRErrorLevels);
begin
  FDelphiZXingQRCode.ErrorLevels := Value;
  Generate;
end;

procedure TfrxBarcodeQR.SetQuietZone(const Value: Integer);
begin
  FDelphiZXingQRCode.QuietZone := Value;
  Generate;
end;

procedure TfrxBarcodeQR.SetText(v: string);
begin
  inherited;
  FDelphiZXingQRCode.Data := v;
  Generate;
end;

function TfrxBarcodeQR.GetPixelSize: integer;
begin
  result := FPixelWidth;
end;

procedure TfrxBarcodeQR.SetPixelSize(v : integer);
begin
  FPixelWidth := v;
  FPixelHeight := v;
end;


{ TfrxBarcodeLogo }

procedure TfrxBarcodeLogo.Assign(Source: TPersistent);
begin
  inherited;
  if Source is  TfrxBarcodeLogo then
  begin
    Width := TfrxBarcodeLogo(Source).Width;
    Height := TfrxBarcodeLogo(Source).Height;
    Logo := TfrxBarcodeLogo(Source).Logo;
  end;

end;

constructor TfrxBarcodeLogo.Create;
begin
  Width := 32;
  Height := 32;
end;

destructor TfrxBarcodeLogo.Destroy;
begin
  FreeAndNil(FLogo);
  inherited;
end;

procedure TfrxBarcodeLogo.Draw(DrawRect: TRect; ScaleX, ScaleY: Extended; Canvas: TCanvas; Zoom: Extended);
var
  W, H: Integer;
begin
  if not Assigned(FLogo) then Exit;
  W := DrawRect.Right - DrawRect.Left;
  H := DrawRect.Bottom - DrawRect.Top;
  DrawRect.Left := DrawRect.Left + Round((W - Width) * ScaleX * Zoom) div 2;
  DrawRect.Top := DrawRect.Top + Round((H - Height) * ScaleY * Zoom) div 2;
  DrawRect.Right := DrawRect.Left + Round(Width * ScaleX * Zoom);
  DrawRect.Bottom := DrawRect.Top + Round(Height * ScaleY * Zoom);
  Canvas.StretchDraw(DrawRect, FLogo.Graphic);
end;

function TfrxBarcodeLogo.GetLogo: TPicture;
begin
  Result := GetLogoInst;
end;

function TfrxBarcodeLogo.GetLogoInst: TPicture;
begin
  if not Assigned(FLogo) then
    FLogo := TPicture.Create;
  Result := FLogo;
end;

procedure TfrxBarcodeLogo.SetLogo(const Value: TPicture);
begin
  GetLogoInst.Assign(Value);
end;

end.
