DTP Toolbox/DTPToolbox.iso/propage4.0/arexx/barcodes.pdrx

Text File | 1995-09-08 | 23.1 KB | 714 lines

/*
Routine to generate bar codes for Pro Draw. Consumer codes (UPC, EAN and ISBN can be drawn singly; others can also be drawn in multiple copies for sheets of labels.
Written by Don Cox, Jan-Dec. '94. Copyright. Not Public Domain.
Requires the files BarCodesEAN.rexx and NumberData.rexx (both in Rexx:).
*/
/* $VER: BarCodes Sept 95 */

/*call open("STDERR","ram:trace","W")
trace r*/

oldunits = pdm_GetUnits()
call pdm_SetUnits(2) /* work in metric throughout */
call pdm_AutoUpdate(0)

if ~show(l, "gdarexxsupport.library") then
   if ~addlib("gdarexxsupport.library",0,-30) then
      exit_msg("Please install the gdarexxsupport.library in your libs: directory before running this Genie.")

numeric digits 14
cr = '0a'x

chosen = getclip(pduschosen)
if chosen = "" then chosen = "NULL"

codelist = "ISBN" ||cr|| "ISBNplus5"||cr||"EAN13"||cr|| "EAN13plus2"||cr|| "EAN13plus5" ||cr|| "EAN8" ||cr|| "EAN8plus2" ||cr|| "EAN8plus5" ||cr|| "UPC-A" ||cr|| "UPC-Aplus2" ||cr|| "UPC-Aplus5"||cr|| "UPC-E" ||cr|| "UPC-Eplus2" ||cr|| "UPC-Eplus5" ||cr|| "ITF (single)"||cr|| "ITF (multiple)"||cr||"Codabar (single)"||cr||"Codabar (multiple)" ||cr|| "Code39 (single)" ||cr|| "Code39 (multiple)"
/* Putting an underscore in front of the default item preselects it */
chosenpos = pos(chosen,codelist)
if chosenpos~=0 then codelist = insert("_",codelist,chosenpos-1)

chosen = pdm_SelectFromList("Select Barcode Format",20,20,2,codelist)
if chosen = "" then exit_msg("Aborted by user")
call setclip(pduschosen,chosen)


box = pdm_ClickArea("Drag out box to contain code")
if box = "" then exit_msg("No box")

numberprompt = getclip(pdusnumbers)

colour1 = getclip(pduscolour1) /* colour selector is in EAN section only */
colour2 = getclip(pduscolour2)
if colour1 = '' then colour1 = "WHITE"
if colour2 = '' then colour2 = "BLACK"
call setclip(pduscolour1,colour1)
call setclip(pduscolour2,colour2)

select
    when left(chosen,4) = "ISBN" then call EAN
    when left(chosen,3) = "EAN" then call EAN
    when left(chosen,3) = "UPC" then call EAN
    otherwise call multi()
    end

call numberdata.rexx(,close) /* Clear clips for drawing numerals */
exit_msg("Finished")
end

/* +++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */

/* Do single or multiple labels */
multi:

multiple = 0
if pos("multi",chosen)~=0 then multiple = 1
first = 1 /* do some things first time only */

inkspread = getclip(pdusspread)
if inkspread = '' then inkspread = 0.00
numberfont = getclip(pdusnumberfont)
if numberfont = "" then numberfont = "B"

parse var box cornerX cornerY cornerX2 cornerY2
cornerY2 = strip(cornerY2) /* remove a space */
boxwidth = abs(cornerX2-cornerX)
boxheight = abs(cornerY2-cornerY)
cpage = pdm_CurrentPage()

rows = 1 /* default */
columns = 1
numpages = 1

if multiple = 1 then do
    numcodes = getclip(pdusnumcodes)
    if numcodes = "" then numcodes=1
    copies = getclip(pduscopies)
    if copies = "" then copies = 1
    pagewidth = getclip(pduspagewidth)
    if pagewidth = "" then pagewidth = 210
    pageheight = getclip(pduspageheight)
    if pageheight = "" then pageheight = 297
    marginX = getclip(pdusmarginX)
    if marginX = "" then marginX = 12
    marginY = getclip(pdusmarginY)
    if marginY = "" then marginY = 12
    rows = getclip(pdusrows)
    if rows = "" then rows = 5
    columns = getclip(pduscolumns)
    if columns = "" then columns = 3

    mstring = "# of codes:"numcodes ||cr|| "Copies of each:"copies ||cr|| "Page Width (mm):"pagewidth ||cr|| "Page Height (mm):"pageheight ||cr|| "Left Margin (mm):"marginX ||cr|| "Top Margin (mm):"marginY ||cr|| "Rows:"rows ||cr|| "Columns:"columns
    form = pdm_GetForm("Enter numbers",28,mstring)
    parse var form numcodes "0a"x copies "0a"x pagewidth "0a"x pageheight "0a"x marginX "0a"x marginY "0a"x rows "0a"x columns

    numcodes = strip(numcodes,,' -')
    copies = strip(copies,,' -')
    pagewidth = strip(pagewidth,,' -')
    pageheight = strip(pageheight,,' -')
    marginX = strip(marginX,,' -')
    marginY = strip(marginY,,' -')
    rows = strip(rows,,' -')
    columns = strip(columns,,' -')

/* Set clips before checking, so they can be edited */
    call setclip(pdusnumcodes,numcodes)
    call setclip(pduscopies,copies)
    call setclip(pduspagewidth,pagewidth)
    call setclip(pduspageheight, pageheight)
    call setclip(pdusmarginX, marginX)
    call setclip(pdusmarginY, marginY)
    call setclip(pdusrows,rows)
    call setclip(pduscolumns, columns)

    if ~datatype(numcodes,n) then exit_msg("Number of codes not valid")
    if ~datatype(copies,n) then exit_msg("Number of copies not valid")
    if ~datatype(pagewidth,n) then exit_msg("Page width not valid")
    if ~datatype(pageheight,n) then exit_msg("Page height not valid")
    if ~datatype(marginX,n) then exit_msg("Margin setting not valid")
    if ~datatype(marginY,n) then exit_msg("Margin setting not valid")
    if ~datatype(rows,n) then exit_msg("Number of rows not valid")
    if ~datatype(columns,n) then exit_msg("Number of columns not valid")

    numcodes = trunc(numcodes)
    copies = trunc(copies)
    rows = trunc(rows)
    columns = trunc(columns)

    pagewidth = pagewidth/10 /* convert to cm */
    pageheight = pageheight/10
    marginX = marginX/10
    marginX2 = 2*marginX
    marginY = marginY/10
    marginY2 = 2*marginY
    numlabels = numcodes*copies
    LabelsPerPage = rows*columns
    numpages = (numlabels%LabelsPerPage)+1
    labelwidth = (pagewidth-marginX2)/columns
    labelheight = (pageheight-marginY2)/rows
    boxwidth = min(boxwidth,labelwidth*0.9)
    boxheight = min(boxheight,labelheight*0.9)
    call pdm_SetPageSize(cpage, pagewidth, pageheight)

    /* if page is not clear, make a new one */
    firstobject = pdm_PageFirstObj()
    if firstobject~=0 then cpage = addpages(1,cpage)

    end

checkprompt = getclip(pduscheckprompt)
if checkprompt = "" then checkprompt = "Y"
fontprompt = getclip(pdusfontprompt)
if fontprompt = "" then fontprompt = "N"


label = 1

do p = 1 to numpages
    if p>1 then cpage = addpages(1,cpage)

    do r = 1 to rows
        if rows>1 then do
            cornerY = (labelheight*(r-1))+marginY
            cornerY2 = cornerY+boxheight
            end
        do c = 1 to columns
            if columns>1 then do
                cornerX = (labelwidth*(c-1))+marginX
                cornerX2 = cornerX + boxwidth
                end
            success = BarCodeMain(chosen, box, colour1, colour2) /* call main program */
            label = label+1
            if label>numlabels then leave p
            end /* of columns */
        end /* of rows */

    end /* of pages */

return

/* ++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */

/* Routine to draw single bar codes, using Pro Draw. */

BarCodeMain:

trace n
parse arg chosen, box, colour1, colour2
numeric digits 14
barcodedone = 0
cr = '0a'x

identity = 1 /* count objects */
curves. = ""

select
    when left(chosen,3) = "ITF" then call ITF
    when left(chosen,7) = "Codabar" then call Codabar
    when left(chosen,6) = "Code39" then call Code39
    otherwise exit_msg("Aborted by User")
    end



identity = identity-1
call pdm_SelectObj(curves.1,curves.identity)
call pdm_GroupObj()

trace n
barcodedone = 1
return barcodedone
end

/* +++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */

EAN:
success = BarCodesEAN.rexx(chosen, box, colour1, colour2, numberprompt, oldunits) /* call separate EAN program */
if success~=1 then exit_msg(success)
return

/* +++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */

/* Final way out */
exit_msg: procedure expose oldunits
do
    parse arg message

    if message ~= '' then call pdm_Inform(1,message,)
    call pdm_ClearStatus()
    call pdm_SetUnits(oldunits)
    call pdm_UpdateScreen(0)
    call pdm_AutoUpdate(1)
    exit
end

/* ++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */

/* Create a new page without adding a blank page at end of document */

addpages: procedure
    parse arg n, cpage
        newpage = pdm_CreatePage(cpage,n,)
        newpage = pdm_MovePage(newpage+n,newpage)
        cpage = pdm_GoToPage(newpage+n)
    return cpage


/* ++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++++++ */

drawbar:

trace n
currentfill = colour2
barleft2 = barleft+inkspread
barright2 = barright-inkspread
obj = pdm_DrawRectangle(barleft2, bartop, barright2, barbottom)
call pdm_SetLineWeight(obj, 0.00)
call pdm_SetFillPattern(obj,1, currentfill)
curves.identity = obj
identity = identity+1

return

/* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */

/* Draw string of numbers */
numberdraw:

trace n
call pdm_ShowStatus("  Drawing Numerals..")
numlength = length(numbers)
numberleft = cornerX+(boxwidth/2)- ((charwidth+(unitwidth*2))* (numlength/2))

if upper(nfset) ~= "N" then do
    fsnumber = 3
    fontselectstring = '"Abort","Select Font","Use Internal Font"'
    if pos("39",chosen)~=0 then do
        fontselectstring = '"Abort","Select Font"'
        fsnumber = 2
        end
    fss ='fontselect = pdm_Inform('||fsnumber||',"Select font...",'||fontselectstring||')'
    interpret fss
    if fontselect = 0 then exit_msg("User aborted program")
    if fontselect = 1 then do
        fontsavail = strip(pdm_GetFontList(),"T","0a"x)
        numberfont = pdm_SelectFromList("Select Font",23,18,0, fontsavail)
        call setclip(pdusnumberfont, numberfont)
        nfset = "N" /* Don't select again if multiple bars */
        end
    if fontselect ~=1 then numberfont = "B"
    end

if numberfont = "B" then do
    if first = 1 then call numberdata.rexx() /* set data for numbers as clips */
    scaleX = charwidth/4.5 /* this arbitrary number depends on the size of  characters in the data strings */
    scaleY = scaleX   /* keep proportions - ignore box height */
    do i = 1 to numlength
        thisnumber = substr(numbers, i,1)
        call drawnumber /* draw single digit */
        numberleft = numberleft + charwidth +(unitwidth*2)/* move to next position*/
        end
    end

else do
    numbergap = cornerY2-barbottom
    points = numbergap *0.8 *28.3 /* 28.3 is cm to points */
    call pdm_InitText(numberfont,points)
    numberbottom = cornerY2 - (numbergap*0.2)
    nresult = pdm_Text(numbers, numberleft, numberbottom)
    Xend = word(nresult,1) /* Text returns coords for next char */
    numlength2 = Xend-numberleft /* Recalculate position */
    numberleft2 = cornerX+((boxwidth/2)- (numlength2/2))
    lastchar = pdm_DocLastObj()
    firstchar = pdm_GroupFirstObj(lastchar)
    shift = numberleft2-numberleft
    call pdm_MoveObj(firstchar, shift, 0)
    do n=firstchar to lastchar
        curves.identity = n
        identity = identity+1
        end
    end

return



/* ++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++ */

/* Draw single number using data in clips set by numberdata.rexx */
drawnumber:

thisclip = "pdusnumdata"||thisnumber
thisdata = getclip(thisclip)
parse var thisdata boxsizeX "0a"x boxsizeY "0a"x numstring1 "0a"x numstring2 "0a"x numstring3

    call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
    call pdm_PlotBezier(numstring1)
    obj = pdm_ClosePlot()
    curves.identity = obj
    call pdm_SetLineWeight(obj, 0.00)
    call pdm_SetFillPattern(obj,1, colour2)
    identity = identity+1

    if numstring2 ~="" then do /* holes in numerals - use solid fills, not compound objects */
        call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
        call pdm_PlotBezier(numstring2)
        obj = pdm_ClosePlot()
        curves.identity = obj
        call pdm_SetLineWeight(obj, 0.00)
        call pdm_SetFillPattern(obj,1, colour1)
        identity = identity+1
        end
    if numstring3 ~="" then do /* some have 2 holes */
        call pdm_initplot(numberleft, numbertop, scaleX, scaleY, 0)
        call pdm_PlotBezier(numstring3)
        obj = pdm_ClosePlot()
        curves.identity = obj
        call pdm_SetLineWeight(obj, 0.00)
        call pdm_SetFillPattern(obj,1, colour1)
        identity = identity+1
        end
return

/* +++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */

/* draw background rectangle */
drawrectangle:
currentfill = colour1
boxright = cornerX + boxwidth
boxbottom = cornerY + boxheight
obj = pdm_DrawRectangle(cornerX, cornerY, boxright, boxbottom)
call pdm_SetLineWeight(obj, 0.00)
call pdm_SetFillPattern(obj,1, currentfill)
curves.identity = obj
identity = identity+1
return

/* +++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++ */

checksum: procedure
parse arg numstring

pos = length(numstring)
total = 0
do until pos<1
    total = total+substr(numstring,pos,1)
    pos=pos-2
    end
total = total*3
pos= length(numstring)-1
total2 = 0
do until pos<1
    total2 = total2+substr(numstring,pos,1)
    pos=pos-2
    end
total=total+total2
ch=10-(total//10)
if ch=10 then ch = 0

numstring = numstring||ch
return numstring

/* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */

/* Normalize numeric input */
clearos: procedure

parse arg numbers
position = 0 /* now replace O's with zeros */
do forever
    position = pos("O", numbers,position+1)
    if position = 0 then break
    numbers = delstr(numbers,position,1)
    numbers = insert("0",numbers,position-1)
    end
position = 0 /* now replace o's with zeros */
do forever
    position = pos("o", numbers,position+1)
    if position = 0 then break
    numbers = delstr(numbers,position,1)
    numbers = insert("0",numbers,position-1)
    end
position = 0 /* now remove hyphens */
do forever
    position = pos("-", numbers,position+1)
    if position = 0 then break
    numbers = delstr(numbers,position,1)
    end

return numbers

/* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */


ITF:

ITFcodes = "00110 10001 01001 11000 00101 10100 01100 00011 10010 01010"

if first = 1 then do
    numberprompt = getclip(pdusnumbers)
    prompt = "Code Numbers:"numberprompt ||cr|| "Ink Spread(mm):0.000" ||cr|| "Checksum? (Y/N):"checkprompt||cr|| "Set Font? (Y/N):"fontprompt
    form = pdm_GetForm("Enter numbers",28,prompt)
    parse var form numbers "0a"x inkspread "0a"x docheck "0a"x nfset
    inkspread = inkspread/10   /* convert to cm */
    dochecksum = 0
    if upper(docheck)="Y" then dochecksum = 1
    call setclip(pduscheckprompt, upper(docheck))
    call setclip(pdusfontprompt, upper(nfset))

    if numbers = "" then exit_msg("User aborted genie")
    numbers = space(numbers,0)  /* strip out all spaces */
    call clearos(numbers)  /* replace any accidental letter Os with zeros */
    ver =verify(numbers,"0123456789")
    if ver~=0 then exit_msg("Letter "substr(numbers,ver,1)" among numbers")
    call setclip(pdusnumbers, numbers)

    numlength = length(numbers)
    if numlength//2~=0 then numbers = "0"||numbers /* must be even number of digits */
    numlength = length(numbers)
    shortlength = numlength
    if dochecksum = 1 then numlength = numlength+2

    boxlength = (numlength*8)+8.5 /* 8.5 for start & stop codes */
    unitwidth = (boxwidth/boxlength)*0.8
    widebar = 2.5*unitwidth
    charwidth = 6*unitwidth

    end

numbers = getclip(pdusnumbers)
if first = 0 then numbers = numbers+((label-1)%copies)
numbers = right(numbers,shortlength,0) /* restore leading zeros after maths */
if dochecksum = 1 then numbers = "0"||checksum(numbers)

call drawrectangle
call pdm_ShowStatus("  Drawing Bars..")
currentfill = colour1

trace n
/* Start code */
bartop = cornerY +(0.1*boxheight)
codebottom = cornerY+ (0.8*boxheight)
barbottom = codebottom
numbertop = cornerY+(boxheight*0.83)

barleft = cornerX+(boxwidth*0.1)
do j = 1 to 4
    barwidth = unitwidth
    barright = barleft + barwidth
    if currentfill = colour1 then call drawbar
    else currentfill = colour1
    barleft = barright
    end

/* Number codes */
do i = 1 to numlength by 2
    pair1 = substr(numbers,i,1)
    pair2 = substr(numbers,i+1,1)
    barpattern1 = word(ITFcodes, pair1+1)
    barpattern2 = word(ITFcodes, pair2+1)
    do j = 1 to 5
        barbit1 = substr(barpattern1,j,1)
        barbit2 = substr(barpattern2,j,1)
        barwidth1 = unitwidth
        if barbit1 = 1 then barwidth1 = widebar
        barwidth2 = unitwidth
        if barbit2 = 1 then barwidth2 = widebar
        barright = barleft + barwidth1
        call drawbar
        barleft = barright + barwidth2
        end

    end

/* Stop code */
    barwidth = widebar
    barright = barleft + barwidth
    call drawbar
    barleft = barright+unitwidth
    barright = barright+(2*unitwidth)
    call drawbar

call numberdraw
trace n
first = 0 /* Don't do setup again */

return

/* ++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */

Codabar:

if first = 1 then do

    codasearch = "0123456789-$:/.+ABCDTN*E"
/* These codes are written as 0=narrow bar, 1=wide bar. Wide bars are 3 times width of narrow bars. */
codacodes = "0000011 0000110 0001001 1100000 0010010 1000010 0100001 0100100 0110000 1001000 0001100 0011000 1000101 1010001 1010100 0010101 0011010 0101001 0001011 0001110 0011010 0101001 0001011 0001110"
/* note codes for A & T, B & N, C & *, D & E are the same, and these pairs are used as start/stop codes. */

    numberprompt = getclip(pdusnumbers)
    prompt = "Code Numbers:"numberprompt ||cr|| "Ink Spread(mm):0.000" ||cr|| "Start/Stop (A/B/C/D):A"||cr|| "Set Font? (Y/N):"fontprompt
    form = pdm_GetForm("Enter numbers",28,prompt)
    parse var form numbers "0a"x inkspread "0a"x startcode "0a"x nfset
    inkspread = inkspread/10   /* convert to cm */
    startcode = upper(startcode)
    startcheck = verify(startcode,"ABCD")
    call setclip(pdusfontprompt, upper(nfset))


    if numbers = "" then exit_msg("User aborted genie")
    numbers = space(numbers,0)  /* strip out all spaces */
    numlength = length(numbers)
    call setclip(pdusnumbers, numbers)

    call clearos(numbers)
    ver =verify(numbers,codasearch)
    if ver~=0 then exit_msg("Letter "substr(numbers,ver,1)" among numbers")

    call setclip(pdusnumbers, numbers)
    end

numbers = getclip(pdusnumbers)
if first = 0 then numbers = numbers+((label-1)%copies)
numbers = right(numbers,numlength,0) /* restore leading zeros */

/* Start and stop codes */
if startcheck = 0 then numbers2 = startcode||numbers||startcode

numlength2 = length(numbers2)
boxlength = numlength2*11.5
unitwidth = (boxwidth/boxlength) * 0.8
widebar = 2.5*unitwidth
charwidth = 10*unitwidth
barleft = cornerX + (boxwidth*0.1)
bartop = cornerY +(boxheight*0.1)
barbottom = cornerY+(boxheight *0.8)
numbertop = cornerY+(boxheight*0.85)

call drawrectangle
call pdm_ShowStatus("  Drawing Bars..")
currentfill = colour1

/* Number codes */
do i = 1 to numlength2
    thisnumber = substr(numbers2,i,1)
    barpattern = word(codacodes, pos(thisnumber,codasearch))
    do j = 1 to 7
        barbit = substr(barpattern,j,1)
        barwidth = unitwidth
        if barbit = 1 then barwidth = widebar
        barright = barleft + barwidth
        if currentfill = colour1 then call drawbar
        else currentfill = colour1
        barleft = barright
        end
    barleft = barleft + unitwidth /* space between chars */
    currentfill = colour1
    end
call numberdraw
first = 0 /* Don't do setup again */

return

/* ++++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++ */

Code39:

if first = 1 then do
    search39 = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%*"
/* Codes are listed here with 0s for narrow bars & 1s for wide bars. Wide bars should be 3 times the width of narrow, but are allowed to be as little as 2.2 times if the printer is accurate. Each pattern of bars is the same total width (3 wide bars & 6 narrow) and a space at least as wide as the narrow bars is left between the character patterns. This is the only common code which can be used like a typeface. */
codes39 ="000110100 100100001 001100001 101100000 000110001 100110000 001110000 000100101 100100100 001100100 100001001 001001001 101001000 000011001 100011000 001011000 000001101 100001100 001001100 000011100 100000011 001000011 101000010 000010011 100010010 001010010 000000111 100000110 001000110 000010110 110000001 011000001 111000000 010010001 110010000 011010000 010000101 110000100 011000100 010101000 010100010 010001010 000101010 010010100"


    prompt = "Code Numbers:"numberprompt ||cr|| "Ink Spread(mm):"inkspread ||cr|| "Checksum? (Y/N):"checkprompt ||cr|| "Set Font? (Y/N):"fontprompt
    if numberfont ="B" then prompt = "Code Numbers:"numberprompt ||cr|| "Ink Spread(mm):"inkspread ||cr|| "Checksum? (Y/N):"checkprompt
    form = pdm_GetForm("Enter letters & numbers",28,prompt)

    parse var form numbers "0a"x inkspread "0a"x docheck "0a"x nfset
    if numberfont ="B" then nfset = "Y" /* If no name, must select - can't use built-in font for Code39 */
    if ~datatype(inkspread,n) then exit_msg("Invalid entry for ink spread: "inkspread)
    call setclip(pdusspread,inkspread)
    inkspread = inkspread/10   /* convert to cm */

    if numbers = "" then exit_msg("User aborted genie")
    numbers = upper(numbers)  /* Spaces are allowed */
    numlength = length(numbers)
    call setclip(pdusnumbers, numbers)
    call setclip(pduscheckprompt, upper(docheck))
    call setclip(pdusfontprompt, upper(nfset))


    ver =verify(numbers,search39)
    if ver~=0 then exit_msg("Invalid character "substr(numbers,ver,1)" among numbers")
    call setclip(pdusnumbers, numbers)
    shortlength = length(numbers)

    end /* of things to do on first label */

numbers = getclip(pdusnumbers)
if first = 0 then do /* have to split off any letters in the code - can't increment letters */
    revnumbers = reverse(numbers) /* work forward from last char */
    alphapos = verify(revnumbers,"1234567890")
    alpha = reverse(substr(revnumbers,alphapos))
    numeric = reverse(left(revnumbers,alphapos-1))
    numericlength = length(numeric)
    if numericlength ~= 0 then do
        numeric = numeric+((label-1)%copies)
        numeric = right(numeric,numericlength,0) /*restore leading zeros */
        end
    numbers = alpha||numeric
    end


if upper(docheck) = "Y" then do
    checktotal = 0
    do i = 1 to numlength
        thischar = substr(numbers,i,1)
        checkvalue = pos(thischar,search39)-1
        checktotal = checktotal+checkvalue
        end
    checkrem = checktotal//43
    checkchar = substr(search39,checkrem+1,1)
    numbers = numbers||checkchar
    end


/* Start and stop codes */
numbers2 = "*"||numbers||"*"


numlength2 = length(numbers2)
boxlength = numlength2*14.5 /* 14.5 is width of 1 char + space */
unitwidth = (boxwidth/boxlength) * 0.8
widebar = 2.5*unitwidth
charwidth = 13*unitwidth
barleft = cornerX + (boxwidth*0.1)
bartop = cornerY + (boxheight * 0.1)
barbottom = cornerY+(boxheight *0.8)
numbertop = cornerY+(boxheight *0.85)

call drawrectangle
call pdm_ShowStatus("  Drawing Bars..")
currentfill = colour1

/* Number codes */
do i = 1 to numlength2
    thisnumber = substr(numbers2,i,1)
    barpattern = word(codes39, pos(thisnumber,search39))
    do j = 1 to 9
        barbit = substr(barpattern,j,1)
        barwidth = unitwidth
        if barbit = 1 then barwidth = widebar
        barright = barleft + barwidth
        if currentfill = colour1 then call drawbar
        else currentfill = colour1
        barleft = barright
        end
    barleft = barleft + unitwidth /* space between chars */
    currentfill = colour1
    end
call numberdraw
first = 0 /* Don't do setup again */

return