GLE Library: barcode.gle

! 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

 

[Return to subroutines page]