acectrl.pas

suite component ace report

unit AceCtrl;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}
uses
{$IFDEF WIN32}
  windows,
{$ELSE}
  winprocs, wintypes,
{$ENDIF}
  SysUtils, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, aceout;


const
  Bar3of9Char: array[0..43] of Char = ('1','2','3','4','5','6','7','8','9','0'
                ,'A','B','C','D','E','F','G','H','I','J','K','L'
                ,'M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'
                ,'-','.',' ','*','$','/','+','%');

  Bar3of9Code: array[0..43] of Byte = ($90,$30,$b0,$18,$98,$38,$12,$92,$32,$1a
                ,$84,$24,$a4,$0c,$8c,$2c,$06,$86,$26,$0e,$81,$21,$a1,$09,$89
                ,$29,$03,$83,$23,$0b,$c0,$60,$e0,$48,$c8,$68,$42,$c2,$62,$4a
                ,$54,$51,$45,$15);

  Bar2of5Char: array[0..9] of Char = ('0','1','2','3','4','5','6','7','8','9');
  Bar2of5Code: array[0..9] of Byte = ($30,$88,$48,$c0,$28,$a0,$60,$18,$90,$50);

type

  TAceBarCode = class(TObject)
  private
    FNarrowWidth: Integer;
    FWideWidth: Integer;
    FVertical: Boolean;
    FHeight: Integer;
    FWidth: Integer;
    FWidthInInches_1000: Boolean;
  protected
  public
    constructor Create; virtual;
    destructor Destroy; override;

    property NarrowWidth: Integer read FNarrowWidth write FNarrowWidth;
    property WideWidth: Integer read FWideWidth write FWideWidth;
    property Vertical: Boolean read FVertical write FVertical;
    property Height: Integer read FHeight write FHeight;
    property Width: Integer read FWidth write FWidth;

    function BarCodeLength(Handle: THandle; Code: String): Integer; virtual; abstract;
    procedure Print(AceCanvas: TAceCanvas; x,y: Integer; Str: String); virtual;
    procedure PrintDC(Handle: THandle; BrushHandle: THandle; x,y: Integer; Str: String); virtual; abstract;
    property WidthInInches_1000: Boolean read FWidthInInches_1000 write FWidthInInches_1000;
  end;

  TAce3of9BarCode = class(TAceBarCode)
  private
    function CharCode(BarChar: Char): String;
  public
    procedure PrintDC(Handle: THandle; BrushHandle: THandle; x,y: Integer; Str: String); override;
    function BarCodeLength(Handle: THandle; Code: String): Integer; override;
  end;

  TAce2of5BarCode = class(TAceBarCode)
  private
    function FindCode(Code: Char; list: array of char; Len: Integer ): Integer;
    function GetBarString(First, Second: Char): String;
  public
    procedure PrintDC(Handle: THandle; BrushHandle: THandle; x,y: Integer; Str: String); override;
    function BarCodeLength(Handle: THandle; Code: String): Integer; override;
  end;


implementation

uses AceUtil;

procedure MyFillRect(Handle: THandle; Rect: TRect; SelectBrush: THandle);
begin
  {$IFDEF WIN32}
  windows.FillRect(Handle, Rect, SelectBrush);
  {$ELSE}
  winprocs.FillRect(Handle, Rect, SelectBrush);
  {$ENDIF}
end;


{ TAceBarCode }
constructor TAceBarcode.Create;
begin
  inherited Create;

  FNarrowWidth := 1;
  FWideWidth := 3;
  FVertical := False;

  FHeight := 0;
  FWidth := 0;
  FWidthInInches_1000 := False;
end;

destructor TAceBarCode.destroy;
begin

  inherited destroy;
end;

procedure TAceBarCode.Print(AceCanvas: TAceCanvas; x,y: Integer; Str: String);
begin
  PrintDC(AceCanvas.Handle, AceCanvas.SelectBrush, x,y,Str);
end;


{ TAce3of9Barcode }
procedure TAce3of9Barcode.PrintDC(Handle: THandle; BrushHandle: THandle; x,y: Integer; Str: String);
var
  R: TRect;
  Code, codelist: String;
  bchar: Char;
  h,w,t,l,pos, spot: LongInt;
  nw,ww: LongInt;
  Inches: Boolean;
  Res: TPoint;
Begin
  Code := UpperCase(Str);

  if Length(Code) > 0 then
  begin
    Inches := FWidthInInches_1000;
    Res := AceGetResolution(Handle);

    { add the begin and end code to the string }
    code := '*' + code + '*';

    nw := FNarrowWidth;
    ww := FWideWidth;
    if Inches then
    begin
      if Vertical then
      begin
        nw := MulDiv(nw,Res.Y,1000);
        ww := MulDiv(ww,Res.Y,1000);
      end else
      begin
        nw := MulDiv(nw,Res.X,1000);
        ww := MulDiv(ww,Res.X,1000);
      end;
    end;
    t := y;
    l := x;
    if FVertical then
    begin
      h := 0;
      w := FWidth;
    end else
    begin
      h := FHeight;
      w := 0;
    end;

    for pos := 0 to Length(Code) - 1 do
    begin
      bchar := Code[pos+1];
      codelist := CharCode(bchar);
      { this is for a narrow space after each character }
      if Length(codelist) > 0 then codelist := codelist + '0';

      for spot := 0 to Length(codelist) - 1 do
      begin
        bchar := Codelist[spot+1];
        if bchar = '1' then
        begin
          if (spot mod 2) = 0 then
          begin
            if FVertical then R := Bounds(l,t,w, ww)
            else R := Bounds(l,t,ww, h);
            MyFillRect(Handle, R, BrushHandle);
          end;
          if FVertical then Inc(t, ww)
          else Inc(l, ww);
        end else
        begin
          if (spot mod 2) = 0 then
          begin
            if FVertical then R := Bounds(l,t,w, nw)
            else R := Bounds(l,t,nw, h);
            MyFillRect(Handle, R, BrushHandle);
          end;
          if FVertical then Inc(t, nw)
          else Inc(l, nw);
        end;
      end;
    end;
  end;
end;

function TAce3of9BarCode.CharCode(barChar: Char): String;
var
  pos: Integer;
  mask, code: Byte;
  count: Integer;
begin
  pos := 0;
  mask := $01;
  code := 0;
  result := '';
  while pos < High(bar3of9Char) do
  begin
    if bar3of9Char[pos] = barChar then
    begin
      code := bar3of9Code[pos];
      pos := High(bar3of9Char);
    end else Inc(pos);
  end;
  if code <> 0 then
  begin
    count := 0;
    for pos := 0 to 7 do
    begin
      if (mask And code) > 0 then
      begin
        result := '1' + result;
        Inc(count);
      end else result := '0' + result;
      if pos < 7 then mask := mask shl 1;
    end;

    if count < 3 then result := result + '1'
    else result := result + '0';

  end;
end;

function TAce3of9BarCode.BarCodeLength(Handle: THandle; Code: String): Integer;
var
  Res: TPoint;
  nw,ww: LongInt;
begin
  nw := FNarrowWidth;
  ww := FWideWidth;
  if FWidthInInches_1000 then
  begin
    Res := AceGetResolution(Handle);
    if Vertical then
    begin
      nw := MulDiv(nw,Res.Y,1000);
      ww := MulDiv(ww,Res.Y,1000);
    end else
    begin
      nw := MulDiv(nw,Res.X,1000);
      ww := MulDiv(ww,Res.X,1000);
    end;
  end;
  { add 2 for starting and ending character
    there is 3 narrrow bars and 7 wide bars }
  Result := (2 + Length(Code)) * ((3*ww)+(7*nw));
end;




{ TAce2of5Barcode }
procedure TAce2of5BarCode.PrintDC(Handle: THandle; BrushHandle: THandle; x,y: Integer; Str: String);
var
  Code: String;
  t,l,pos: Integer;
  nw,ww: LongInt;
  Inches: Boolean;
  Res: TPoint;

  procedure DrawBar(BarChar: Char);
  var
    Space: Integer;
  begin
    case BarChar of
      '0','1': Space := nw;
      '2','3': Space := ww;
    else Space := 0
    end;

    if (BarChar = '0') or (BarChar = '2') then
    begin
      if FVertical then MyFillRect(Handle, Bounds(l,t,FWidth, Space), BrushHandle)
      else MyFillRect(Handle, Bounds(l,t,Space, FHeight), BrushHandle);
    end;

    if FVertical then Inc(t, Space)
    else Inc(l, Space);

  end;
  procedure DrawBarString(BarString: String);
  var
    Spot: Integer;
  begin
    For Spot := 0 to Length(BarString) - 1 do DrawBar(BarString[Spot + 1]);
  end;
  function ValidCode(C: String): Boolean;
  const
    Digits: set of '0'..'9' = ['0'..'9'];
  var
    Spot: Integer;
  begin
    Result := True;
    For Spot := 1 to Length(C) do
      if Not (C[Spot] in Digits) then Result := False;
  end;
Begin
  Code := Str;

  if (Length(Code) > 0) And ValidCode(Code) then
  begin
    Inches := FWidthInInches_1000;
    Res := AceGetResolution(Handle);

    nw := FNarrowWidth;
    ww := FWideWidth;
    if Inches then
    begin
      if Vertical then
      begin
        nw := MulDiv(nw,Res.Y,1000);
        ww := MulDiv(ww,Res.Y,1000);
      end else
      begin
        nw := MulDiv(nw,Res.X,1000);
        ww := MulDiv(ww,Res.X,1000);
      end;
    end;


    t := y;
    l := x;
    DrawBarString('0101');

    Pos := 1;
    { interleaved varcodes must have an even number of characters printed.}
    if Not ((Length(Code) mod 2) = 0) then
    begin
      DrawBarString(GetBarString('0', Code[Pos]));
      Pos := Pos + 1
    end;
    while Pos < Length(Code) do
    begin
      DrawBarString(GetBarString(Code[Pos], Code[Pos+1]));
      Pos := Pos + 2
    end;

    DrawBarString('210');
  end;
end;

function TAce2of5BarCode.FindCode(Code: Char; list: array of char; Len: Integer ): Integer;
var
  Pos: Integer;
begin
  Result := -1;
  Pos := 0;
  while Pos < Len do
  begin
    if list[pos] = Code then
    begin
      Result := Pos;
      Pos := Len;
    end else Inc(pos);
  end;
end;

function TAce2of5BarCode.GetBarString(First, Second: Char): String;
var
  pos: Integer;
  mask, FirstCode, SecondCode: Byte;
begin
  mask := $80;
  result := '';
  FirstCode := 0;
  SecondCode := 0;
  Pos := FindCode(First, bar2of5Char, High(bar2of5Char) + 1);
  if Pos <> -1 then
  begin
    FirstCode := bar2of5Code[Pos];
    Pos := FindCode(Second, bar2of5Char, High(bar2of5Char) + 1);
    if Pos <> -1 then SecondCode := bar2of5Code[Pos];
  end;

  { 0 - Narrow Bar
    1 - Narrow Space
    2 - Wide Bar
    3 - Wide Space }
  if Pos <> -1 then
  begin
    for Pos := 0 to 4 do
    begin
      if (mask And FirstCode) > 0 then
      begin
        Result := Result + '2';
      end else Result := Result + '0';
      if (mask And SecondCode) > 0 then
      begin
        Result := Result + '3';
      end else Result := Result + '1';
      Mask := Mask shr 1;
    end;
  end;
end;

function TAce2of5BarCode.BarCodeLength(Handle: THandle; Code: String): Integer;
var
  Len: Integer;
  Res: TPoint;
  nw,ww: LongInt;
begin

  nw := FNarrowWidth;
  ww := FWideWidth;
  if FWidthInInches_1000 then
  begin
    Res := AceGetResolution(Handle);
    if Vertical then
    begin
      nw := MulDiv(nw,Res.Y,1000);
      ww := MulDiv(ww,Res.Y,1000);
    end else
    begin
      nw := MulDiv(nw,Res.X,1000);
      ww := MulDiv(ww,Res.X,1000);
    end;
  end;


  Len := Length(Code);
  if Not ((Length(Code) mod 2) = 0) then Len := Len + 1;

  { add 6 narrow and 1 width bars for starting and ending character
    there is 3 narrrow bars and 2 wide bars }
  Result := ww+(6*nw) + (Len * ((2*ww)+(3*nw)));
end;

end.