
{ ****************************************** }
{                                            }
{             FastReport v5.0                }
{          2D Barcode base class             }
{                                            }
{         Copyright (c) 1998-2014            }
{         by Alexander Tzyganenko,           }
{            Fast Reports Inc.               }
{                                            }
{ ****************************************** }

unit frxBarcode2DBase;
//{$Define RandVertCol}
interface

{$I frx.inc}

uses
  Classes, SysUtils,
{$IFDEF FPC}
  LResources, LMessages, LCLType, LCLIntf, LazarusPackageIntf,
  LCLProc, FileUtil, LazHelper,
{$ELSE}
  Windows,
{$ENDIF}
  Graphics, Types, frxPrinter;

type

  T2DBooleanArray = array of array of Boolean;

  /// ////////////////////////////////////////////////////////////////////////////////////////////
  // base 2D barcode class
  /// ////////////////////////////////////////////////////////////////////////////////////////////

{$M+}
  TfrxBarcode2DBase = class(TObject)
  protected
    FHeight: Integer; // height of barcode matrix
    FWidth: Integer; // Width of barcode matrix
    FPixelWidth: Integer;
    FPixelHeight: Integer;
    FShowText: Boolean;
    FRotation: Integer;
    FText: String;
    FZoom: Extended;
    FFontScaled: Boolean; // scale font with barcode
    FFont: TFont;
    FColor: TColor;
    FColorBar: TColor;
    FErrorText: String;
    FQuietZone: Integer; // paddings

    procedure SetShowText(v: Boolean); virtual;
    procedure SetRotation(v: Integer); virtual;
    procedure SetText(v: String); virtual;
    procedure SetZoom(v: Extended); virtual;
    procedure SetFontScaled(v: Boolean); virtual;
    procedure SetFont(v: TFont); virtual;
    procedure SetColor(v: TColor); virtual;
    procedure SetColorBar(v: TColor); virtual;
    procedure SetErrorText(v: String); virtual;
    procedure SetHeight(const Value: Integer); virtual;

    function GetWidth: Integer; virtual;
    function GetHeight: Integer; virtual;
    procedure InternalDraw(aCanvas: TCanvas; scalex, scaley: Extended;
      x, y, footerHeight, dx, dy, paddingX, paddingY: Integer;
      kx, ky: Extended); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign(src: TfrxBarcode2DBase); virtual;
    function GetFooterHeight: Integer; virtual;

    procedure Draw2DBarcode(var g: TCanvas; scalex, scaley: Extended;
      x, y: Integer); virtual;
    procedure FillRect(Canv: TCanvas; Rect: TRect);
    function IsScaled: Boolean; virtual;

    property ShowText: Boolean read FShowText write SetShowText;
    property Rotation: Integer read FRotation write SetRotation;

    property Text: String read FText write SetText;
    property Zoom: Extended read FZoom write SetZoom;
    property FontScaled: Boolean read FFontScaled write SetFontScaled;
    property Font: TFont read FFont write SetFont;
    property Color: TColor read FColor write SetColor;
    property ColorBar: TColor read FColorBar write SetColorBar;
    property ErrorText: String read FErrorText write SetErrorText;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight write SetHeight;
    property PixelWidth: Integer read FPixelWidth write FPixelWidth;
    property PixelHeight: Integer read FPixelHeight write FPixelHeight;
    property QuietZone: Integer read FQuietZone write FQuietZone;
  end;

  TfrxBarcode2DBaseWithUnion = class(TfrxBarcode2DBase)
  protected
    FVectorPrimitives: TList;
    DotsR, DotsL: array of Byte;
  public
    procedure FVectorPrimitivesAdd(ALeft, ATop, AWidth, AHeight: Integer);

    constructor Create; override;
    destructor Destroy; override;

    procedure ClearFigures();
    procedure T2DBooleanArrayToVectorPrimitives(GlArr: T2DBooleanArray; x, y: Byte; QuietZone: Byte = 0);
    procedure InternalDraw(aCanvas: TCanvas; scalex, scaley: Extended;
      x, y, footerHeight, dx, dy, paddingX, paddingY: Integer;
      kx, ky: Extended); override;
  end;

  TfrxBarcode2DBaseWithOutUnion = class(TfrxBarcode2DBase)
  protected
    FImage: array of Byte; // boolean array of barcode data
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure InternalDraw(aCanvas: TCanvas; scalex, scaley: Extended;
      x, y, footerHeight, dx, dy, paddingX, paddingY: Integer;
      kx, ky: Extended); override;
  end;

const
  cbDefaultText = '12345678';

implementation

uses frxUtils
{$IFDEF LCLGTK2}
  , Printers
{$ENDIF};

constructor TfrxBarcode2DBase.Create;
begin
  FWidth := 0;
  FHeight := 0;
  FPixelWidth := 2;
  FPixelHeight := 2;
  FShowText := true;
  FRotation := 0;
  FText := cbDefaultText;
  FZoom := 1;
  FFontScaled := true;
  FColor := clWhite;
  FColorBar := clBlack;
  FFont := TFont.Create;
  FFont.Name := 'Arial';
  FFont.Size := 9;
  FQuietZone := 0;
end;

constructor TfrxBarcode2DBaseWithUnion.Create;
begin
  inherited;
  FVectorPrimitives := TList.Create();
end;

constructor TfrxBarcode2DBaseWithOutUnion.Create;
begin
  inherited;
end;

procedure TfrxBarcode2DBaseWithUnion.FVectorPrimitivesAdd(ALeft, ATop, AWidth, AHeight: Integer);
var
  PonterRect: PRect;
begin
  New(PonterRect);
  PonterRect.Left   := ALeft;
  PonterRect.Top    := ATop;
  PonterRect.Right  := AWidth;
  PonterRect.Bottom := AHeight;
  FVectorPrimitives.Add(PonterRect);
end;

procedure TfrxBarcode2DBaseWithUnion.InternalDraw(aCanvas: TCanvas; scalex,
  scaley: Extended; x, y, footerHeight, dx, dy, paddingX, paddingY: Integer; kx,
  ky: Extended);
var
  k, j, i, x1, y1, x2, y2: Integer;
begin
  inherited;

  //dots
  for i := 0 to length(DotsR)-1 do
  begin
    j := DotsR[i];
    k := DotsL[i];

    case round(Rotation) of
      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;
      else
        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;
    end;
    FillRect(aCanvas, Rect(x1 + paddingX, y1 + paddingY, x2 + paddingX, y2 + paddingY))
  end;

  //figures
  for i := 0 to FVectorPrimitives.Count-1 do
  begin
    j := PRect(FVectorPrimitives[i]).Left;
    k := PRect(FVectorPrimitives[i]).Top;

  {$IFDEF RandVertCol}
    aCanvas.Brush.Color := RGB(Random(256), Random(256), Random(256));
    aCanvas.Pen.Color := RGB(Random(256), Random(256), Random(256));
  {$ENDIF}

    case round(Rotation) of
      90:
        begin
          x1 := round(x + k * PixelHeight * kx );
          x2 := round(x + k * PixelHeight * kx + PixelHeight * kx* PRect(FVectorPrimitives[i]).Bottom);
          y1 := round(y + dx - j * PixelWidth * ky);
          y2 := round(y + dx - j * PixelWidth * ky - PixelWidth * ky* PRect(FVectorPrimitives[i]).Right);
        end;
      180:
        begin
          x1 := round(x + dx - j * PixelWidth * kx);
          x2 := round(x + dx - j * PixelWidth * kx - PixelWidth * kx* PRect(FVectorPrimitives[i]).Right);
          y1 := round(y + footerHeight + dy - k * PixelHeight * ky);
          y2 := round(y + footerHeight + dy - k * PixelHeight * ky - PixelHeight * ky * PRect(FVectorPrimitives[i]).Bottom);
        end;
      270:
        begin
          x1 := round(x + footerHeight + dy - k * PixelHeight * kx);
          x2 := round(x + footerHeight + dy - k * PixelHeight * kx - PixelHeight * kx* PRect(FVectorPrimitives[i]).Bottom);
          y1 := round(y + j * PixelWidth * ky);
          y2 := round(y + j * PixelWidth * ky + PixelWidth * ky* PRect(FVectorPrimitives[i]).Right);
        end;
      else
        begin
          x1 := round(x + j * PixelWidth * kx);
          x2 := round(x + j * PixelWidth * kx  + PixelWidth * kx * PRect(FVectorPrimitives[i]).Right);
          y1 := round(y + k * PixelHeight * ky);
          y2 := round(y + k * PixelHeight * ky + PixelHeight * ky * PRect(FVectorPrimitives[i]).Bottom);
        end;
    end;
    FillRect(aCanvas, Rect(x1 + paddingX, y1 + paddingY, x2 + paddingX, y2 + paddingY))
  end;
end;

procedure TfrxBarcode2DBaseWithUnion.T2DBooleanArrayToVectorPrimitives(GlArr: T2DBooleanArray; x, y: Byte; QuietZone: Byte = 0);
var
  i,j,k,l,m0,cols,rows: integer;
  res: TRect;
  arr: T2DBooleanArray;
begin
  ClearFigures();
  SetLength(arr,x,y);
  for i := 0 to x - 1 - QuietZone * 2 do
    for j := 0 to y - 1 - QuietZone * 2 do
      arr[i + QuietZone][j + QuietZone] := GlArr[i][j];

  while True do
  begin
  res := Rect(1,1,1,1);
    for i := 0 to x-1 do
    begin
      for j := 0 to y-1 do
      begin
        if arr[i][j] then
        begin
          m0:=y;
          cols:=0;
          for k := i to x-1 do
          begin
            if not arr[k,j] then break;
            inc(cols);
            rows:=0;
            for l := j to m0-1 do
            begin
              inc(rows);
              if arr[k,l] then
              begin
                if (res.Right * res.Bottom < cols*rows) then
                begin
                res := Rect(i, j, cols, rows);
                end;
              end
              else
              begin
                m0:=l;
                break;
              end;
            end;
          end;
        end;
      end;
    end;

    if res.Right * res.Bottom > 1 then
    begin
        FVectorPrimitivesAdd(res.Left, res.Top, res.Right, res.Bottom);
        for cols := res.Left to res.Left + res.Right - 1 do
        begin
          for rows := res.Top to res.Top + res.Bottom - 1 do
          begin
            arr[cols][rows] := False;
          end;
        end;
    end
    else
      break;
  end;

  l := 0;
  for i := 0 to x-1 do
    for j := 0 to y-1 do
      if arr[i][j] then
        inc(l);

  setlength(DotsR, l);
  setlength(DotsL, l);
  l := 0;
  for i := 0 to x-1 do
    for j := 0 to y-1 do
      if arr[i][j] then
      begin
        DotsR[l] := i;
        DotsL[l] := j;
        inc(l);
        arr[i][j] := False;
      end;
end;

procedure TfrxBarcode2DBase.Assign(src: TfrxBarcode2DBase);
begin
  FShowText := src.FShowText;
  FRotation := src.FRotation;
  FText := src.FText;
  FZoom := src.FZoom;
  FPixelWidth := src.FPixelWidth;
  FPixelHeight := src.FPixelHeight;
  FFontScaled := src.FFontScaled;
  FFont.Assign(src.FFont);
  FColor := src.FColor;
  FColorBar := src.FColorBar;
  FErrorText := src.FErrorText;
  FQuietZone := src.FQuietZone;
end;

procedure TfrxBarcode2DBase.SetShowText(v: Boolean);
begin
  FShowText := v;
end;

procedure TfrxBarcode2DBase.SetRotation(v: Integer);
begin
  FRotation := v;
end;

procedure TfrxBarcode2DBase.SetText(v: String);
begin
  if (FText <> v) then
    FText := v;
end;

procedure TfrxBarcode2DBase.SetZoom(v: Extended);
begin
  FZoom := v;
end;

procedure TfrxBarcode2DBase.SetFontScaled(v: Boolean);
begin
  FFontScaled := v;
end;

procedure TfrxBarcode2DBase.SetHeight(const Value: Integer);
begin
//
end;

procedure TfrxBarcode2DBase.SetFont(v: TFont);
begin
  FFont.Assign(v);
end;

procedure TfrxBarcode2DBase.SetColor(v: TColor);
begin
  FColor := v;
end;

procedure TfrxBarcode2DBase.SetColorBar(v: TColor);
begin
  FColorBar := v;
end;

procedure TfrxBarcode2DBase.SetErrorText(v: String);
begin
  FErrorText := v;
end;

function TfrxBarcode2DBase.GetFooterHeight: Integer;
begin
  Result := -Font.Height - Font.Height div 4;
end;

function TfrxBarcode2DBase.GetWidth: Integer;
begin
  Result := round(FWidth * FPixelWidth + FQuietZone * 2);
end;

procedure TfrxBarcode2DBase.InternalDraw(aCanvas: TCanvas; scalex,
  scaley: Extended; x, y, footerHeight, dx, dy, paddingX, paddingY: Integer; kx,
  ky: Extended);
begin
// do nothing
end;

function TfrxBarcode2DBase.IsScaled: Boolean;
begin
  Result := False;
end;

function TfrxBarcode2DBase.GetHeight: Integer;
begin
  if FShowText then
    Result := round(FHeight * FPixelHeight - FFont.Height - FFont.Height div 4 +
      FQuietZone * 2)
  else
    Result := round(FHeight * FPixelHeight + FQuietZone * 2);
end;

destructor TfrxBarcode2DBase.Destroy;
begin
  FFont.Free;
end;

destructor TfrxBarcode2DBaseWithOutUnion.Destroy;
begin
  setlength(FImage, 0);
  inherited;
end;

procedure TfrxBarcode2DBaseWithOutUnion.InternalDraw(aCanvas: TCanvas; scalex,
  scaley: Extended; x, y, footerHeight, dx, dy, paddingX, paddingY: Integer; kx,
  ky: Extended);
var
  k, j, b, p: Integer;
  x1, y1, x2, y2: Integer;
begin
  inherited;

  for k := 0 to FHeight - 1 do
  begin
    p := k * ((FWidth + 7) div 8);
    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
        continue;

      case round(Rotation) of
        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;
        else
          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;
      end;
    FillRect(aCanvas, Rect(x1 + paddingX, y1 + paddingY, x2 + paddingX, y2 + paddingY))
    end;
  end;
end;

destructor TfrxBarcode2DBaseWithUnion.Destroy;
begin
  ClearFigures();
  FVectorPrimitives.Destroy();
  inherited;
end;

procedure TfrxBarcode2DBaseWithUnion.ClearFigures();
var
  i: Integer;
begin
  for i := 0 to FVectorPrimitives.Count-1 do
    Dispose(PRect(FVectorPrimitives[i]));
  FVectorPrimitives.Clear();
end;

procedure TfrxBarcode2DBase.Draw2DBarcode(var g: TCanvas; scalex, scaley: Extended; x, y: Integer);
var
  F: TLogFont;
  FontHandle, OldFontHandle: HFont;
  koeff_for_font_height, kx, ky: Extended;
  textLeftOffset, textSemiLength, txtX, txtY: Integer;
  footerHeight, dx, dy, paddingX, paddingY: Integer;
  YDPI: Integer;
begin
  Color := Color;
  kx := scalex * Zoom;
  ky := scaley * Zoom;
  footerHeight := 0;
  if IsScaled then
  begin
    FHeight := 0;
    GetHeight;
  end;
  dy := round(FHeight * PixelHeight * ky);
  dx := round(FWidth * PixelWidth * kx);
  paddingX := round(FQuietZone * kx);
  paddingY := round(FQuietZone * ky);
  txtX := 0;
  txtY := 0;

  if ShowText then
  begin
    g.Font.Assign(FFont);
    GetObject(g.Font.Handle, SizeOf(TLogFont), @F);
    F.lfEscapement := round(Rotation * 10);
    F.lfOrientation := round(Rotation * 10);
    koeff_for_font_height := 1.0;
    if not (g is {$IFDEF LCLGTK2}TPrinterCanvas{$ELSE}TfrxPrinterCanvas{$ENDIF}) then
      koeff_for_font_height := scaley;
    {$IFDEF LCLGTK2}
    if g is TPrinterCanvas then
      YDPI := (g as TPrinterCanvas).YDPI
    else
    {$ENDIF}
     YDPI := GetDeviceCaps(g.Handle, LOGPIXELSY);
    if FontScaled then
      F.lfHeight := -round(MulDiv(FFont.Size, YDPI, 72) * Zoom * koeff_for_font_height)
    else
      F.lfHeight := -round(MulDiv(FFont.Size, YDPI, 72) * koeff_for_font_height);
    FontHandle := CreateFontIndirect(F);
    OldFontHandle := SelectObject(g.Handle, FontHandle);
    g.Font.Handle := FontHandle;
    g.Brush.Color := Color;
    frxSetBkMode(g, Transparent);
    {$IFDEF LCLGTK2}
    if g is TPrinterCanvas then
     g.Font.Height := -round(MulDiv(FFont.Size, YDPI, 72) * koeff_for_font_height);
    {$ENDIF}

    textSemiLength := g.TextWidth(Text) div 2;
    footerHeight := -g.Font.Height div 4 - g.Font.Height;

    textLeftOffset := dx div 2 - textSemiLength;
    if textLeftOffset < 0 then
      textLeftOffset := 0;

    case round(Rotation) of
      0:
        begin
          txtX := textLeftOffset;
          txtY := dy
        end;
      90:
        begin
          txtX := dy;
          txtY := dx - textLeftOffset;
        end;
      180:
        begin
          txtX := dx - textLeftOffset;
          txtY := footerHeight;
        end;
      270:
        begin
          txtX := footerHeight;
          txtY := textLeftOffset;
        end;
    end;
    inc(txtX, x);
    inc(txtY, y);

    g.TextOut(txtX + paddingX, txtY + paddingY, Text);
    SelectObject(g.Handle, OldFontHandle);
    {$IFNDEF FPC}
    DeleteObject(FontHandle);
    {$ENDIF}
  end;

//  case round(Rotation) of
//    0, 180:
//      begin
//        x1 := round(x);
//        y1 := round(y);
//        x2 := round(x + FWidth * PixelWidth * kx);
//        y2 := round(y + FHeight * PixelHeight * ky)+ footerHeight;
//      end;
//    90, 270:
//      begin
//        x1 := round(x);
//        y1 := round(y);
//        x2 := round(x + FHeight * PixelHeight * ky)+ footerHeight;
//        y2 := round(y + FWidth * PixelWidth * kx);
//      end;
//  end;

  g.Brush.Color := FColorBar;
  {$IFDEF RandVertCol}
  g.Pen.Width := 0; //Width = frame(ramka) in Polygon(...) where '0' = '1 pixel'...i don't understand
  {$ELSE}
  g.Pen.Style := psClear;
  {$ENDIF}
  InternalDraw(g, scalex, scaley, x, y, footerHeight, dx, dy, paddingX, paddingY, kx, ky);
end;

procedure TfrxBarcode2DBase.FillRect(Canv: TCanvas; Rect: TRect);
begin
  Canv.Polygon([
             Point(Rect.Left , Rect.Top),
             Point(Rect.Left , Rect.Bottom),
             Point(Rect.Right, Rect.Bottom),
             Point(Rect.Right, Rect.Top)
             ]);
end;

end.
