//---------------------------------------------------------------------------
// Generowanie kodow kreskowych EAN8
// 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;

  EAN8 : array [0..7] of Byte;
  bars : array [0..66] 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) <> 8 then
            begin
                ShowMessage('Incorrect EAN8 number');
                exit;
            end;

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

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

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

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

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

        bars[31] := 0;
        bars[32] := 1;
        bars[33] := 0;
        bars[34] := 1;
        bars[35] := 0;

         for i:=4 to 7 do
                for j:=0 to 6 do
                        bars[(i-4)*7 + 36 + j] := rightValues[EAN8[i], j];

        bars[64] := 1;
        bars[65] := 0;
        bars[66] := 1;

        DrawBars;

end;

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


        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Rectangle(0, 0, 177, 121);
        Image1.Canvas.Brush.Color := clBlack;
        for i:=0 to 66 do
           begin
                if (((i >= 0) and (i<= 2)) or
                    ((i >= 31) and (i<= 35)) or
                    ((i >= 64) and (i<= 66))) 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:=0 to 3 do
                Image1.Canvas.TextOut(i*14 + 31, 100, IntToStr(EAN8[i]));

        for i:=4 to 7 do
                Image1.Canvas.TextOut(i*14 + 41, 100, IntToStr(EAN8[i]));

end;


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

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

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

        if EAN8[7] = sum then
                Result := true
        else
                Result := false;
end;

end.