Subj : barcodes
To   : All
From : Jasen Betts
Date : Thu Mar 27 2003 04:27 pm

This came up in a discussion in a different echo, I thought some people
here might find it of intertest.

Program BarCode (input,output);
{simple EAN13 / UPC-A generator, public domain, By jasen Betts, 1999}

{for a hard copy, redirect output to a printer capable of printing IBM block
 graphics chars, under windows use "terminal" or one of the "dos" fonts.}

const coding:array['0'..'9','A'..'D',1..6] of char=(
       {A}      {B}      {C}      {D}
{0} ('  ## #','#  ###','###  #','AAAAAA'),
{1} (' ##  #','##  ##','##  ##','AABABB'),
{2} (' #  ##',' ## ##','## ## ','AABBAB'),
{3} ('#### #','#    #','#    #','AABBBA'),
{4} ('#   ##',' ### #','# ### ','ABAABB'),
{5} ('##   #','###  #','#  ###','ABBAAB'),
{6} ('# ####','   # #','# #   ','ABBBAA'),
{7} ('### ##',' #   #','#   # ','ABABAB'),
{8} ('## ###','  #  #','#  #  ','ABABBA'),
{9} ('  # ##',' # ###','### # ','ABBABA'));

         {block graphics chars '  ' ' #' '# ' '##'}
display:array[0..3] of char = (#255,#222,#221,#219);

var
number,bars:string;
x,y:integer;
a:char;
first:'0'..'9';       {the first digit}
symset:'A'..'C';  {symbol set}

begin
number:=paramstr(1);
if number = '' then begin
  write ('enter bar-code number :');
  readln(number);
end;

y:=0;                               {simple cleaning of the input str}
for x:=1 to length(number) do
  if number[x] in ['0'..'9'] then begin
    inc(y);
    number[y]:=number[x];
  end;
number[0]:=char(y);
                                {build the bars using the coding array}
if y<13 then first:='0' else first:=number[y-12];
bars:='# # ';
write(first);
for x:=-11 to 0 do begin;
  if y+x<1 then a:='0' else a:=number[y+x];
  write(a);
  if x>-6 then symset :='C' else symset := coding[first,'D',x+12];
  bars:=bars+coding[a,symset]+'.';
  if x=-6 then bars:=bars+'# #.';
end;
writeln;
bars:=bars+'# # ';{trailing space to make length even}

for y:=1 to 3 do begin  { convert to graphics chars, print out }
  for x:=0 to 47 do
    write(display[ord(bars[x*2+1]='#')*2+ord(bars[x*2+2]='#')]);
  writeln;
end;
end.

 -=> Bye <=-

---
 * Origin: Dogs come when you call, cats have answering machines (3:640/1042)

.