SUBROUTINE MAKEBARCODE (WIDTH, HEIGHT, ORIEN, VALUE)
* $OPTIONS EXT ;* FIXED 18/1/2012
* PURPOSE : PRINT BARCODE (CODE 128) ON HP LASERJET PRINTERS
** RELEASE : 4.0
*************************************************************************
* This subroutine is used to print bar codes HP laserjet printers using
* the Printer Control Language.
*
* WIDTH (input) - If a whole number is passed it will be the number of
* dots for a single bar (300 dpi). If a number less
* one is used it is assumed to be inches for a single
* bar (ex .010 is the same as 3 dots). If the value
* is null or zero the default of 3 dots (.010") will be
* used. (max is 15 dots or .5")
*
* HEIGHT (input) - If a whole number is passed it will be the number of
* dots for the overall barcode height (300 dpi). If a
* decimal number is used, it is assumed to be inches.
* (ex. for a 1/2 inch barcode use 150 or .5). The
* maximum is 900 dots or 3.0 inches.
*
* ORIEN (input) - Orientation of the barcode. Use "0" for horizontal
* (lines going up and down) and "1" for vertical. The
* default is zero.
*
* VALUE (input) - This is the actual data to be encoded.
*
* Note: The barcode is printed from the current cursor position. After
* the barcode is printed the cursor is repositioned back to its
* original coordinates.
*************************************************************************
AM = CHAR(254); VM = CHAR(253)
EQU TRUE TO 1, FALSE TO 0
EQU BS TO CHAR(8), ESC TO CHAR(27)
EQU CODEA TO 1, CODEB TO 2, CODEC TO 3 ;* code fields
*
GOSUB BUILD.TABLE
*
IF WIDTH = "" OR WIDTH = "0" OR NOT(NUM(WIDTH)) THEN WIDTH = 3
IF INDEX(WIDTH,".",1) THEN WIDTH = (300 * WIDTH) 'R#0'
IF WIDTH > 15 THEN WIDTH = 15
*
IF HEIGHT = "" OR HEIGHT = "0" OR NOT(NUM(HEIGHT)) THEN
HEIGHT = 150
END
IF INDEX(HEIGHT,".",1) THEN HEIGHT = (300 * HEIGHT) 'R#0'
IF HEIGHT > 900 THEN HEIGHT = 900
*
IF ORIEN # 1 THEN ORIEN = FALSE ELSE ORIEN = TRUE
*
CHECKSUM = 0
BAR.CNT = 0
POSX = 0
POSY = 0
*************************************************************************
* MAIN
*************************************************************************
*
* print the start code
BEGIN CASE
CASE VALUE[1,4] MATCHES "4N"
CODE.FLD = CODEC
POS = 106
CASE VALUE[1,1] < CHAR(32) ;* control character
CODE.FLD = CODEA
POS = 104
CASE TRUE
CODE.FLD = CODEB
POS = 105
END CASE
GOSUB PRINT.BAR
*************************************************************************
* print the bar code for each character
ICNT = LEN(VALUE)
FOR I = 1 TO ICNT
BEGIN CASE
CASE CODE.FLD # CODEC AND VALUE[I,6] MATCHES "6N"
POS = 100 ;* from A or B to C
GOSUB PRINT.BAR
CODE.FLD = CODEC
CASE CODE.FLD = CODEC AND NOT(VALUE[I,2] MATCHES "2N")
CHR = VALUE[I,1]
* LOCATE CHR IN TABLE<CODEB> SETTING FND THEN
LOCATE(CHR,TABLE,CODEB;FND) THEN
POS = 101 ;* from C to B
GOSUB PRINT.BAR
CODE.FLD = CODEB
END ELSE
POS = 102 ;* from C to A
GOSUB PRINT.BAR
CODE.FLD = CODEA
END
END CASE
IF CODE.FLD = CODEC THEN
CHR = VALUE[I,2]
I += 1
END ELSE
CHR = VALUE[I,1]
END
* LOCATE CHR IN TABLE<CODE.FLD> SETTING POS ELSE
LOCATE(CHR,TABLE,CODE.FLD;POS) ELSE
BEGIN CASE
CASE CODE.FLD = CODEA
POS = 101 ;* from A to B
GOSUB PRINT.BAR
CODE.FLD = CODEB
CASE CODE.FLD = CODEB
POS = 102 ;* from B to A
GOSUB PRINT.BAR
CODE.FLD = CODEA
END CASE
* LOCATE CHR IN TABLE<CODE.FLD> SETTING POS ELSE
LOCATE(CHR,TABLE,CODE.FLD;POS) ELSE
PRINT "BAR-ERROR!":
RETURN ;* error
END
END
GOSUB PRINT.BAR
NEXT I
*************************************************************************
* print the modulo 103 check character
POS = MOD(CHECKSUM,103) + 1
GOSUB PRINT.BAR
*************************************************************************
* print the stop character
POS = 107
GOSUB PRINT.BAR
*************************************************************************
* reposition the cursor
PRINT ESC:"*p-":POSX:"x-":POSY:"Y":
RETURN
*************************************************************************
PRINT.BAR:
BAR.PATTERN = TABLE<4,POS>
JCNT = LEN(BAR.PATTERN)
FOR J = 1 TO JCNT STEP 2
BAR = BAR.PATTERN[J,1]
SPC = BAR.PATTERN[J+1,1]
IF NOT(ORIEN) THEN
PRINT ESC:"*c":BAR*WIDTH:"a":HEIGHT:"b0P":
NEWX = (BAR*WIDTH)+(SPC*WIDTH)-1
PRINT ESC:"*p+":NEWX:"x+0Y":
POSX += NEWX
END ELSE
PRINT ESC:"*c":HEIGHT:"a":BAR*WIDTH:"b0P":
NEWY = (BAR*WIDTH)+(SPC*WIDTH)-1
PRINT ESC:"*p+0x+":NEWY:"Y":
POSY += NEWY
END
NEXT J
IF BAR.CNT = 0 THEN
CHECKSUM += (POS-1)
END ELSE
CHECKSUM += (POS-1) * BAR.CNT
END
BAR.CNT += 1
RETURN
*************************************************************************
BUILD.TABLE:
TABLE = ''
FLD = 0
FOR I = 32 TO 95
FLD += 1
TABLE<1,FLD> = CHAR(I)
NEXT I
*
FOR I = 0 TO 31
FLD += 1
TABLE<1,FLD> = CHAR(I)
NEXT I
*
FOR I = 32 TO 127
TABLE<2,I-31> = CHAR(I)
NEXT I
*
FOR I = 0 TO 99
TABLE<3,I+1> = I'R%2'
NEXT I
*
TABLE<4> ='212222':VM:'222122':VM:'222221':VM:'121223':VM:'121322':VM:'131222':VM:'122213':VM:'122312'
TABLE<4,-1>='132212':VM:'221213':VM:'221312':VM:'231212':VM:'112232':VM:'122132':VM:'122231'
TABLE<4,-1>='113222':VM:'123122':VM:'123221':VM:'223211':VM:'221132':VM:'221231':VM:'213212'
TABLE<4,-1>='223112':VM:'312131':VM:'311222':VM:'321122':VM:'321221':VM:'312212':VM:'322112'
TABLE<4,-1>='322211':VM:'212123':VM:'212321':VM:'232121':VM:'111323':VM:'131123':VM:'131321'
TABLE<4,-1>='112313':VM:'132113':VM:'132311':VM:'211313':VM:'231113':VM:'231311':VM:'112133'
TABLE<4,-1>='112331':VM:'132131':VM:'113123':VM:'113321':VM:'133121':VM:'313121':VM:'211331'
TABLE<4,-1>='231131':VM:'213113':VM:'213311':VM:'213131':VM:'311123':VM:'311321':VM:'331121'
TABLE<4,-1>='312113':VM:'312311':VM:'332111':VM:'314111':VM:'221411':VM:'431111':VM:'111224'
TABLE<4,-1>='111422':VM:'121124':VM:'121421':VM:'141122':VM:'141221':VM:'112214':VM:'112412'
TABLE<4,-1>='122114':VM:'122411':VM:'142112':VM:'142211':VM:'241211':VM:'221114':VM:'413111'
TABLE<4,-1>='241112':VM:'134111':VM:'111242':VM:'121142':VM:'121241':VM:'114212':VM:'124112'
TABLE<4,-1>='124211':VM:'411212':VM:'421112':VM:'421211':VM:'212141':VM:'214121':VM:'412121'
TABLE<4,-1>='111143':VM:'111341':VM:'131141':VM:'114113':VM:'114311':VM:'411113':VM:'411311'
TABLE<4,-1>='113141':VM:'114131':VM:'311141':VM:'411131':VM:'211412':VM:'211214':VM:'211232'
TABLE<4,-1>='2331112'
RETURN
*************************************************************************
END