//---------------------------------------------------------------------------
// Generowanie kodow kreskowych EAN8p5
// 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;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  EAN5 : array [0..4] of Byte;
  bars : array [0..46] 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..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)
                )
        );

  checksumTable : array [0..9] of array [0..4] of Byte = (
        (1, 1, 0, 0, 0),
        (1, 0, 1, 0, 0),
        (1, 0, 0, 1, 0),
        (1, 0, 0, 0, 1),
        (0, 1, 1, 0, 0),
        (0, 0, 1, 1, 0),
        (0, 0, 0, 1, 1),
        (0, 1, 0, 1, 0),
        (0, 1, 0, 0, 1),
        (0, 0, 1, 0, 1)
        );

implementation

{$R *.DFM}

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


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

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

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

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

        addCheckSum :=  3*EAN5[0] + 3*EAN5[2] + 3*EAN5[4];
        addCheckSum := addCheckSum + 9*EAN5[1] + 9*EAN5[3];
        addCheckSum := addCheckSum mod 10;

         for i:=0 to 4 do
            begin
                for j:=0 to 6 do
                        bars[i*9 + 4 + j] := leftValues[checksumTable[addCheckSum, i], EAN5[i], j];
                if i<4 then
                    begin
                        bars[i*9 + 11] := 0;
                        bars[i*9 + 12] := 1;
                    end;
             end;

        DrawBars;

end;

procedure TForm1.DrawBars;
var
        i : Integer;
begin


        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Rectangle(0, 0, 177, 121);
        Image1.Canvas.Brush.Color := clBlack;

        Image1.Canvas.Font.Size := 10;
        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Font.Color := clBlack;

        for i:=0 to 46 do
                if bars[i] = 1 then
                        Image1.Canvas.Rectangle(i*2 + 20, 40, i*2 + 22, 100);

        for i:=0 to 4 do
                Image1.Canvas.TextOut(i*18 + 23, 20, IntToStr(EAN5[i]));

end;

end.