Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Bar code Printing
Message
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01053083
Message ID:
01057788
Views:
20
Gerald,
I´ve been following this for a while and here are my 2 cents:

Here´s the source for a free Truetype EAN-13 font I´ve been using successfully:
http://www.storm.ca/~dan/
You can print on any laser or bubble jet or generic lable printer.

And here is the proc for coding EAN13 with this font, which is the more complicated one of barcodes (lead, left / right half, middle char, checksum)
*ean13
#DEFINE EAN13LHA 48
#DEFINE EAN13LHB 64
#DEFINE EAN13RH 80
#DEFINE EAN131STFLAG 33
#DEFINE EAN132NDFLAG 96
#DEFINE EAN13CHECK 112
#DEFINE EAN13CENTER 124

PROCEDURE ean13
PARAMETERS cArtNr5 &&5- oder 12-stellig
PRIVATE cEAN13Str,nEAN13Sum,nCntr1,loob,cEAN13Bar

DIMENSION aStFlgSq[9,5]
aStFlgSq=EAN13LHB
*aStFlgSq[0]=0
aStFlgSq[1,1]=EAN13LHA
aStFlgSq[1,3]=EAN13LHA
aStFlgSq[2,1]=EAN13LHA
aStFlgSq[2,4]=EAN13LHA
aStFlgSq[3,1]=EAN13LHA
aStFlgSq[3,5]=EAN13LHA
aStFlgSq[4,2]=EAN13LHA
aStFlgSq[4,3]=EAN13LHA
aStFlgSq[5,3]=EAN13LHA
aStFlgSq[5,4]=EAN13LHA
aStFlgSq[6,4]=EAN13LHA
aStFlgSq[6,5]=EAN13LHA
aStFlgSq[7,2]=EAN13LHA
aStFlgSq[7,4]=EAN13LHA
aStFlgSq[8,2]=EAN13LHA
aStFlgSq[8,5]=EAN13LHA
aStFlgSq[9,3]=EAN13LHA
aStFlgSq[9,5]=EAN13LHA

cEAN13Str=IIF(LEN(cArtNr5)=12,"",ean13cc()+ean13subs())+cArtNr5
loob=.T. &&logigal var: len or digits Out Of Bounds
IF LEN(cEAN13Str)=12
 loob=.F.
 FOR nCntr1=1 TO 12
  loob=loob OR NOT SUBSTR(cEAN13Str,nCntr1,1)$"1234567890" &&digits 1 to 0 (0-9) only!
 ENDFOR nCntr1=1 TO 12
ENDIF LEN(cEAN13Str)=12

IF loob
 cEAN13Bar=CHR(EAN131STFLAG)
ELSE loob
 nEAN13Sum=0
 cEAN13Bar=""
*position counted leftwards from the rightmost of the 12 data chars!!!
 FOR nCntr1=1 TO 12 &&1=12th position=even!!! 12=1st pos=odd
*calculate checksum - mod=even, but odd position
  nEAN13Sum=nEAN13Sum+VAL(SUBSTR(cEAN13Str,nCntr1,1))*IIF(MOD(nCntr1,2)=0,3,1)
*assemble cEAN13Bar
  DO CASE
  CASE nCntr1=1
   cEAN13Bar=cEAN13Bar+CHR(EAN131STFLAG+VAL(SUBSTR(cEAN13Str,nCntr1,1)))
  CASE nCntr1=2
   cEAN13Bar=cEAN13Bar+CHR(EAN132NDFLAG+VAL(SUBSTR(cEAN13Str,nCntr1,1)))
  CASE nCntr1>7
   cEAN13Bar=cEAN13Bar+CHR(EAN13RH+VAL(SUBSTR(cEAN13Str,nCntr1,1)))
  OTHERWISE &&3-7
   IF cEAN13Str="0"
    cEAN13Bar=cEAN13Bar+CHR(EAN13LHA+VAL(SUBSTR(cEAN13Str,nCntr1,1)))
   ELSE cEAN13Str="0"
    cEAN13Bar=cEAN13Bar+CHR(aStFlgSq[val(left(cEAN13Str,1)),nCntr1-2];
     +VAL(SUBSTR(cEAN13Str,nCntr1,1)))
   ENDIF ,cEAN13Str="0"
   cEAN13Bar=cEAN13Bar+IIF(nCntr1=7,CHR(EAN13CENTER),"")
  ENDCASE
 ENDFOR nCntr1=1 TO 12
*calculate and add check char val
 cEAN13Bar=cEAN13Bar+CHR(EAN13CHECK+MOD(10-MOD((nEAN13Sum),10),10))
ENDIF ,loob
RETURN cEAN13Bar
Have fun
G
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform