//---------------------------------------------------------------------------
// Generowanie kodow kreskowych MSI
// 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;
    GroupBox1: TGroupBox;
    mod10: TRadioButton;
    mod10mod10: TRadioButton;
    mod11: TRadioButton;
    mod11mod10: TRadioButton;
    noCheck: TRadioButton;
    procedure Button1Click(Sender: TObject);
  private
    curentPos: Integer;
    procedure DrawBars(txt: String);
    procedure DrawSignBars(bars: array of Byte);
    function Check(txt: String): Boolean;
    function CheckLetter(ch: Char): Boolean;
    function GetLetterValue(ch: Char) : Integer;
    function CheckCheckDigit(txt: String): Boolean;
    function Mod10checkDigit(txt: String; len: Integer): Integer;
    function Mod11checkDigit(txt: String; len: Integer): Integer;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  MSIsign: array[0..15] of char = (
      '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
      'A', 'B', 'C', 'D', 'E', 'F');

  MSIbars: array[0..15] of array[0..11] of byte = (
        (1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0),
        (1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0),
        (1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0),
        (1, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0),
        (1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0),
        (1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0),
        (1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0),
        (1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0),
        (1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0),
        (1, 1, 0, 1, 0, 0, 1, 0, 0, 1, 1, 0),
        (1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0),
        (1, 1, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0),
        (1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 0),
        (1, 1, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0),
        (1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 0, 0),
        (1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0)
        );

   mod10values: array[0..15] of Integer = (
        0, 1, 4, 3, 8, 5, 3, 7, 7, 9, 2, 11, 6, 13, 10, 15
        );

   start: array[0..2] of byte = (
        1, 1, 0
        );

   stop: array[0..3] of byte = (
        1, 0, 0, 1
        );

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin


        if Check(Kod.Text) = False then
            begin
                ShowMessage('Incorrect text');
                exit;
            end;

        if CheckCheckDigit(Kod.Text) = False then
            begin
                ShowMessage('Incorrect check digit');
                exit;
            end;


        DrawBars(Kod.Text);

end;

function TForm1.Check(txt: String): Boolean;
var
        i: Integer;
        res: Boolean;
begin
        res := True;

        for i:=1 to Length(txt) do
                if (CheckLetter(txt[i])) = False then
                        begin
                                res := False;
                                break;
                        end;

        Result := res;
end;

function TForm1.CheckLetter(ch: Char): Boolean;
var
        i: Integer;
        res: Boolean;
begin
        res := False;

        for i:=0 to 15 do
                if MSIsign[i] = ch then
                        begin
                                res := True;
                                break;
                        end;

        Result := res;
end;

// returns letter value for check digit
function TForm1.GetLetterValue(ch: Char) : Integer;
var
        i: Integer;
begin
        Result := 0;

        for i:=0 to 10 do
                if (MSIsign[i] = ch) then
                        begin
                                Result := i;
                                break;
                        end;
end;


function TForm1.CheckCheckDigit(txt: String): Boolean;
var
        len: Integer;
begin
        len := Length(txt);

        Result := true;

        // check check digits
        if (mod10.Checked) then
        begin
                if (GetLetterValue(txt[len]) <> mod10checkDigit(txt, len-1)) then
                        Result := false;
        end
        else if (mod10mod10.Checked) then
        begin
                if (getLetterValue(txt[len-1]) <> mod10checkDigit(txt, len-2)) or
                   (getLetterValue(txt[len]) <> mod10checkDigit(txt, len-1)) then
                        Result := false;
        end
        else if (mod11.Checked) then
        begin
                if (getLetterValue(txt[len]) <> mod11checkDigit(txt, len-1)) then
                        Result := false;
        end
        else if (mod11mod10.Checked) then
        begin
                if (getLetterValue(txt[len-1]) <> mod11checkDigit(txt, len-2)) or
                   (getLetterValue(txt[len]) <> mod10checkDigit(txt, len-1)) then
                        Result := false;
        end;
end;

//calculate modulo 10 check digit
function TForm1.Mod10checkDigit(txt: String; len: Integer): Integer;
var
        i, sum : Integer;
begin
        sum := 0;
        for i:=1 to len do
                sum := sum + mod10values[getLetterValue(txt[i])];

        sum := sum mod 10;
        sum := 10 - sum;
        sum := sum mod 10;

        Result := sum;
end;

//calculate modulo 11 check digit
function TForm1.Mod11checkDigit(txt: String; len: Integer): Integer;
var
        i, sum, w : Integer;
begin
        sum := 0;
        w := 0;

        for i:=len downto 1 do
        begin
                sum := sum + getLetterValue(txt[i]) * (w + 2);
                w := w + 1;
                w := w mod 6;
        end;
        sum := sum mod 11;
        sum := 11 - sum;
        sum := sum mod 11;

        Result := sum;
end;

procedure TForm1.DrawBars(txt: String);
var
        i, j: Integer;
begin
        curentPos := 0;
        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Rectangle(0, 0, 441, 121);

        //print start character
        drawSignBars(start);

        //print characters
        for i:=1 to Length(txt) do
                for j:=0 to 15 do
                        if MSIsign[j] = txt[i] then
                                begin
                                        drawSignBars(MSIbars[j]);
                                        break;
                                end;

        //stop character
        drawSignBars(stop);

        //Draw text
        Image1.Canvas.Font.Size := 10;
        Image1.Canvas.Brush.Color := clWhite;
        Image1.Canvas.Font.Color := clBlack;
        Image1.Canvas.TextOut(curentPos div 2 + 20 - Length(txt)*3, 100, txt);
end;

procedure TForm1.DrawSignBars(bars: array of Byte);
var
        i : Integer;
begin
        Image1.Canvas.Brush.Color := clBlack;

        //print bars
        for i:=Low(bars) to High(bars) do
                begin
                        if (bars[i] = 1) then
                                Image1.Canvas.Rectangle(curentPos + 20, 10, curentPos + 22, 100);

                        curentPos := curentPos + 2;
                end;
end;

end.