//---------------------------------------------------------------------------
// Generowanie kodow kreskowych UPC-A
// www.algorytm.org
// (c)2007 Tomasz Lubinski

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Kod: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    procedure DrawBars;
    function Check: Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  UPCA : array [0..12] of Byte;
  bars : array [0..94] of Byte;

  rightValues : array [0..9] of array [0..6] of Byte = (
        (1, 1, 1, 0, 0, 1, 0),
        (1, 1, 0, 0, 1, 1, 0),
        (1, 1, 0, 1, 1, 0, 0),
        (1, 0, 0, 0, 0, 1, 0),
        (1, 0, 1, 1, 1, 0, 0),
        (1, 0, 0, 1, 1, 1, 0),
        (1, 0, 1, 0, 0, 0, 0),
        (1, 0, 0, 0, 1, 0, 0),
        (1, 0, 0, 1, 0, 0, 0),
        (1, 1, 1, 0, 1, 0, 0)
        );

  leftValues : array [0..9] of array [0..6] of Byte = (
        (0, 0, 0, 1, 1, 0, 1),
        (0, 0, 1, 1, 0, 0, 1),
        (0, 0, 1, 0, 0, 1, 1),
        (0, 1, 1, 1, 1, 0, 1),
        (0, 1, 0, 0, 0, 1, 1),
        (0, 1, 1, 0, 0, 0, 1),
        (0, 1, 0, 1, 1, 1, 1),
        (0, 1, 1, 1, 0, 1, 1),
        (0, 1, 1, 0, 1, 1, 1),
        (0, 0, 0, 1, 0, 1, 1)
        );
implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
        i, j : Integer;
begin


        if Length(Kod.Text) <> 12 then
            begin
                ShowMessage('Incorrect UPC-A number');
                exit;
            end;

        for i:=0 to 11 do
                UPCA[i] := StrToInt(Kod.Text[i+1]);

        for i:=0 to 94 do
                bars[i] := 0;

        if Check() = false then
            begin
                ShowMessage('Incorrect UPCA number');
                exit;
            end;

        bars[0] := 1;
        bars[1] := 0;
        bars[2] := 1;

        for i:=0 to 5 do
                for j:=0 to 6 do
                        bars[i*7 + 3 + j] := leftValues[UPCA[i], j];

        bars[45] := 0;
        bars[46] := 1;
        bars[47] := 0;
        bars[48] := 1;
        bars[49] := 0;

         for i:=6 to 11 do
                for j:=0 to 6 do
                        bars[i*7 + 8 + j] := rightValues[UPCA[i], j];

        bars[92] := 1;
        bars[93] := 0;
        bars[94] := 1;

        DrawBars;

end;

procedure TForm1.DrawBars;
var
        i, length : Integer;
begin


        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Rectangle(0, 0, 225, 121);
        Image1.Canvas.Brush.Color := clBlack;
        for i:=0 to 94 do
           begin
                if (((i >= 0) and (i<= 10)) or
                    ((i >= 45) and (i<= 49)) or
                    ((i >= 85) and (i<= 94))) then
                    length := 110
                else
                    length := 100;
                if bars[i] = 1 then
                        Image1.Canvas.Rectangle(i*2 + 20, 10, i*2 + 22, length);
           end;

        Image1.Canvas.Font.Size := 10;
        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Font.Color := clBlack;
        for i:=1 to 5 do
                Image1.Canvas.TextOut(i*14 + 29, 100, IntToStr(UPCA[i]));

        for i:=6 to 10 do
                Image1.Canvas.TextOut(i*14 + 39, 100, IntToStr(UPCA[i]));

        Image1.Canvas.TextOut(7, 90, IntToStr(UPCA[0]));
        Image1.Canvas.TextOut(213, 90, IntToStr(UPCA[11]));        
end;


function TForm1.Check: Boolean;
var
        sum, sum_even, sum_uneven, i: Integer;
begin
        sum_even := 0;
        sum_uneven := 0;

        for i:=0 to 10 do
           if (i mod 2) = 0 then
                sum_even := sum_even + UPCA[i]
           else
                sum_uneven := sum_uneven + UPCA[i];

        sum := sum_uneven + sum_even*3;
        sum := sum mod 10;
        sum := 10 - sum;
        sum := sum mod 10;

        if UPCA[11] = sum then
                Result := true
        else
                Result := false;
end;

end.