//---------------------------------------------------------------------------
// Generowanie kodow Pharmacode two-track
// 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
    curentPos: Integer;
    procedure DrawBars(txt: String);
    procedure DrawSignBar(bar: Char);
    function Check(txt: String): Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin


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

        DrawBars(Kod.Text);

end;

function TForm1.Check(txt: String): Boolean;
var
        i: Integer;
begin
        i:= StrToInt(txt);
        if (i<4) or (i>64570080) then
           Result := False
        else
           Result := True;
end;

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

        i := StrToInt(txt);
        while (i <> 0) do
           begin
                if ((i mod 3) = 0) then
                   begin
                        drawSignBar('N');
                        i := (i-3) div 3;
                   end
                else if ((i mod 3) = 2) then
                   begin
                        drawSignBar('A');
                        i := (i-2) div 3;
                   end
                else
                   begin
                        drawSignBar('B');
                        i := (i-1) div 3;
                   end
           end;
end;

procedure TForm1.DrawSignBar(bar: Char);
var
        top, down : Integer;
begin
        Image1.Canvas.Brush.Color := clBlack;

        if (bar = 'A') then    //above
           begin
                top := 10;
                down := 34;
           end
        else if (bar = 'B') then //below
           begin
                top := 34;
                down := 58;
           end
        else                     //normal
           begin
                top := 10;
                down := 58;
           end;

        Image1.Canvas.Rectangle(curentPos + 20, top, curentPos + 26, down);

        curentPos :=  curentPos - 12;
end;

end.