//---------------------------------------------------------------------------
// Generowanie kodow kreskowych EAN13
// www.algorytm.org
// (c)2005 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;

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

  parityTable : array [0..9] of array [0..5] of Byte = (
        (0, 0, 0, 0, 0, 0),
        (0, 0, 1, 0, 1, 1),
        (0, 0, 1, 1, 0, 1),
        (0, 0, 1, 1, 1, 0),
        (0, 1, 0, 0, 1, 1),
        (0, 1, 1, 0, 0, 1),
        (0, 1, 1, 1, 0, 0),
        (0, 1, 0, 1, 0, 1),
        (0, 1, 0, 1, 1, 0),
        (0, 1, 1, 0, 1, 0)
        );

  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..1] of 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)
                ),
                (
                        (0, 1, 0, 0, 1, 1, 1),
                        (0, 1, 1, 0, 0, 1, 1),
                        (0, 0, 1, 1, 0, 1, 1),
                        (0, 1, 0, 0, 0, 0, 1),
                        (0, 0, 1, 1, 1, 0, 1),
                        (0, 1, 1, 1, 0, 0 ,1),
                        (0, 0, 0, 0, 1, 0, 1),
                        (0, 0, 1, 0, 0, 0 ,1),
                        (0, 0, 0, 1, 0, 0, 1),
                        (0, 0, 1, 0, 1, 1, 1)
                )
        );
implementation

{$R *.DFM}

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


        if Length(Kod.Text) <> 13 then
            begin
                ShowMessage('Incorrect EAN13 number');
                exit;
            end;

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

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

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

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

        for i:=1 to 6 do
                for j:=0 to 6 do
                        bars[(i-1)*7 + 3 + j] := leftValues[parityTable[EAN13[0], i-1], EAN13[i], j];

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

         for i:=7 to 12 do
                for j:=0 to 6 do
                        bars[(i-7)*7 + 50 + j] := rightValues[EAN13[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<= 2)) or
                    ((i >= 45) and (i<= 49)) or
                    ((i >= 92) 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 6 do
                Image1.Canvas.TextOut(i*14 + 17, 100, IntToStr(EAN13[i]));

        for i:=7 to 12 do
                Image1.Canvas.TextOut(i*14 + 27, 100, IntToStr(EAN13[i]));

        Image1.Canvas.TextOut(7, 90, IntToStr(EAN13[0]));
end;


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

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

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

        if EAN13[12] = sum then
                Result := true
        else
                Result := false;
end;

end.