! Subroutines to draw EAN-13 barcodes ! Author: Jan Soubusta x=.04 ! ... narrow line/space width ! tloustka tenke cary/mezery y=1.4 ! ... short line length ! vyska cary nad cisly y2=y+.2 ! ... long line length ! vyska delsich carek bok=10*x ! ... side space ! bocni okraj v ramecku dole=1. ! ... bottom space with text ! spodni okraj s textem (popisek) dolet=.6 ! ... bottom text distance ! vzdalenost dolniho textu hore=.4 ! ... top space ! horni okraj sx=2*bok+95*x ! ... total box size ! velikost boxu sy=y+dole+hore ! ... -"- cypos = .17 ! ... numbers distance from lines ! posun cisel text_hei = .4 ! ... test size col_bc$="black" ! ... bar color sub l p a b c d if p>2 then p=p-2 z=a a=d d=z z=b b=c c=z end if if p=1 then rmove a*x 0 box b*x y nobox fill col_bc$ rmove (b+c)*x 0 box d*x y nobox fill col_bc$ rmove d*x 0 else if p=2 then box a*x y nobox fill col_bc$ rmove (a+b)*x 0 box c*x y nobox fill col_bc$ rmove (c+d)*x 0 end if end sub sub levy rmove 0 -.2 box x y2 nobox fill col_bc$ rmove 2*x 0 box x y2 nobox fill col_bc$ rmove x .2 end sub sub centr rmove x -.2 box x y2 nobox fill col_bc$ rmove 2*x 0 box x y2 nobox fill col_bc$ rmove 2*x .2 end sub sub pravy rmove 0 -.2 box x y2 nobox fill col_bc$ rmove 2*x 0 box x y2 nobox fill col_bc$ end sub sub carky p t rmove 3.5*x -cypos write t rmove -3.5*x cypos if t=0 then @l p 1 1 2 3 else if t=1 then @l p 1 2 2 2 else if t=2 then @l p 2 2 1 2 else if t=3 then @l p 1 1 4 1 else if t=4 then @l p 2 3 1 1 else if t=5 then @l p 1 3 2 1 else if t=6 then @l p 4 1 1 1 else if t=7 then @l p 2 1 3 1 else if t=8 then @l p 3 1 2 1 else if t=9 then @l p 2 1 1 3 end if end sub begin object bar_code prv lft$ rgt$ tx$ set just cc hei .3 local schema$ if prv=0 then schema$="333333" else if prv=1 then schema$="331311" else if prv=2 then schema$="331131" else if prv=3 then schema$="331113" else if prv=4 then schema$="313311" else if prv=5 then schema$="311331" else if prv=6 then schema$="311133" else if prv=7 then schema$="313131" else if prv=8 then schema$="313113" else schema$="311313" end if box sx sy fill white nostroke rmove bok dole begin origin @levy for i=1 to 6 @carky val(seg$(schema$,i,i)) val(seg$(lft$,i,i)) next i @centr for i=1 to 6 @carky 4 val(seg$(rgt$,i,i)) next i @pravy amove -3.5*x -cypos write prv amove 98.5*x -cypos text > amove 47.5*x -dolet set hei text_hei write tx$ end origin end object