PureBasic Forums - English

Posted: **Sat Oct 18, 2003 3:33 pm**

Code updated for 5.20+

In my work for a management software i had the need to create and use bar codes. This is a small procedure that generates a Universal Product Code Barcode.

Code: Select all

; *** UPC BARCODE ***
;
; by Num3 - 2003
;
; Credit must be given to me if procedure is used ;)



Procedure barcode(lnumber.s,rnumber.s,size.l,target.s)
  
  ; *** Check Input ***
  
  If lnumber="" Or rnumber="" Or size<1 Or target=""
    ProcedureReturn
  EndIf
  
  ; *** Barcode Digits ***
  ; Left Digits
  
  Dim digitsl.s(10)
  
  digitsl(0)="0001101"
  digitsl(1)="0011001"
  digitsl(2)="0010011"
  digitsl(3)="0111101"
  digitsl(4)="0100011"
  digitsl(5)="0110001"
  digitsl(6)="0101111"
  digitsl(7)="0111011"
  digitsl(8)="0110111"
  digitsl(9)="0001011"
  
  ; Rigth Digits
  Dim digitsr.s(10)
  
  digitsr(0)="1110010"
  digitsr(1)="1100110"
  digitsr(2)="1101100"
  digitsr(3)="1000010"
  digitsr(4)="1011100"
  digitsr(5)="1001110"
  digitsr(6)="1010000"
  digitsr(7)="1000100"
  digitsr(8)="1001000"
  digitsr(9)="1110100"
  
  
  ; *** CONVERSION ***
  
  out.s="101" ; Left start bars
  
  For x=1 To Len(lnumber)
    out.s + digitsl(Val(Mid(lnumber,x,1)))
  Next
  
  out.s + "01010"  ; Middle bars
  
  For x=1 To Len(rnumber)
    out.s + digitsr(Val(Mid(rnumber,x,1)))
  Next
  
  out.s+"101" ; Right end bars
  
  unit= size
  width= Len(out) * unit 
  height=width/2
  
  
  ; *** DRAWING ***
  CreateImage(0,width,height)
  
  If StartDrawing(ImageOutput(0))
    Box(0,0,width,height,RGB(255,255,255))
    For x=1 To Len(out)
      If Mid(out,x,1) = "0"
        color=RGB(255,255,255)
      ElseIf Mid(out,x,1) = "1"
        color=RGB(0,0,0)
      EndIf   
      If x < 4 Or x > Len(out)-4
        Box(unit * (x-1), 0 ,unit,height,color)
      Else
        Box(unit * (x-1), 0 ,unit,height-(2*unit),color)
      EndIf
    Next
    StopDrawing()
  EndIf
    
  SaveImage(0, target+".bmp")
EndProcedure






; *** USAGE ***

; lnumber.s - Left Number
; rnumber.s - Right Number
; size.l    - Width in pixels of one bar
; target.s  - Location and file name (without extention)

barcode("423537","001012",2,"UPC_BARCODE")

Posted: **Mon Oct 20, 2003 10:48 pm**

Thanks for sharing.

Posted: **Tue Oct 21, 2003 6:34 am**

Cool.

Works better than any TTF. What a pity, we don't use UPC in europe as often as americans do. Do you know more about Code 2/5 Interleaved ?

Posted: **Tue Oct 21, 2003 6:59 pm**

I'm currently studing several barcode standars and i'll be sharing the code has i progress...

Posted: **Tue Oct 21, 2003 7:06 pm**

Pandora wrote:Cool.
Works better than any TTF. What a pity, we don't use UPC in europe as often as americans do. Do you know more about Code 2/5 Interleaved ?

That's not true, all supermarkets use this type of barcode, it's universal, so it will read on any scanner. Even the reader on the newstand you buy a pack of cigs can read it.

There are some variants, that are specific to other activities like medical suplies for example.

The code above only generates the Barcode with the numbers you supply, but it does not check the rules for barcode generating of products...

Posted: **Wed Oct 22, 2003 9:04 am**

Well, in fact, the germans use the so called "EAN". It's very similar to UPC and JAN.

I've compared the barcode displayed on my glass of chocolate spread with a the same code generated by your routine.

The number is 4005500280125.

My scanning device was not able to read your code. (Symbol Handscan) :roll:
There are some differences between yours and the original bar-structure.
EAN indicates itself with an "A" in front of the number.

Well, code 2/5 Interleaved is mostly used in mail delivery services, DHL or UPS. Try this link for more about 2/5:

http://www.xircuit.com/Code25.php

Kind regards

Heiko

Posted: **Wed Oct 22, 2003 9:52 pm**

Pandora wrote: My scanning device was not able to read your code. (Symbol Handscan) :roll: Heiko

Ehehe a live guiny pig for me to test my code with

Pandora wrote:Well, code 2/5 Interleaved is mostly used in mail delivery services, DHL or UPS. Try this link for more about 2/5:

Just check it out... And it's a sod

3 of 9 and 128 are easy, but high compression Barcodes are hard, cause no one gives the info away, just generic output, you have to buy access to that kind of stuff

Anyway code 3 of 9 (39) is well under development ATM from some examples i found on the web

Posted: **Wed Mar 15, 2006 2:10 am**

num3,
This is a really old post but a neat little piece of code!
Do you have an updated version?
I tried it with some UPC codes I have here in my office using PB4 and it looks SOOO close but not quite right ... ?
Maybe I need a scanner to really test it but visually it looks different?

Posted: **Wed Mar 15, 2006 9:40 am**

the code in the above example can´t scan either with Gryphon M100 or DLL-5510 (both from DATALOGIC)

try out a working code :

Code: Select all

barcode("341098","765342",2,"c:\UPC_BARCODE")

Posted: **Wed May 03, 2006 9:41 pm**

Hi,
Num3,
as long as i know, your program is wrong making UPC-A barcodes; it is not so simple.

Here is my tip for this thread:

Code: Select all

; *** EAN13 and UPC-A BARCODE ***
; by Psychophanta - 2006

;NOTE: Encoding a UPC-A symbol is identical to encoding a EAN-13,
; a "0" is simply inserted in front of the UPC-A code itself (i.e., if the barcode is 075678164125,
; a zero is inserted before the code, making the EAN-13 symbol 0075678164125).

; *************************** EAN13 and UPC-A BARCODE USAGE ****************************
;*NumberSystem.s: The number system consists of two digits (sometimes three digits)
; which identify the country (or economic region) numbering authority which assigned the manufacturer code.
; Any number system which starts with the digit 0 is a UPC-A barcode.
;*ManufacturerCode.s: The manufacturer code is a unique code assigned to each manufacturer by the numbering
; authority indicated by the number system code. All products produced by a given company will use the same
; manufacturer code.
;*ProductCode.s: The product code is a unique code assigned by the manufacturer. Unlike the manufacturer code,
; which must be assigned by the UCC, the manufacturer is free to assign product codes to each of their
; products without consulting any other organization. Since the UCC will already have guaranteed that the
; manufacturer code is unique, the manufacturer need only make sure that they do not repeat their own product codes.
;*CheckDigit.s: The check digit is an additional digit used to verify that a barcode has been scanned correctly.
; Since a scan can produce incorrect data due to inconsistent scanning speed, print imperfections, or a host
; of other problems, it is useful to verify that the rest of the data in the barcode has been correctly interpreted.
; The check digit is calculated based on the rest of the digits of the barcode. Normally, if the check digit is
; the same as the value of the check digit based on the data that has been scanned, there is a high level of
; confidence that the barcode was scanned correctly.
;*size.l: Width in pixels of one bar
;*target.s: Location and file name (without extension)

Procedure.b EAN13barcode(NumberSystem.s,ManufacturerCode.s,ProductCode.s,CheckDigit.s,size.l,target.s)
  ; *** Check Input ***
  If Len(NumberSystem)<2 Or Len(NumberSystem)>3 Or Len(ManufacturerCode)>5 Or Len(ManufacturerCode)<4 Or Len(ProductCode)<>5 Or Len(CheckDigit)<>1 Or size<1 Or target=""
    ProcedureReturn 0
  EndIf
  If (Len(NumberSystem)=2 And Len(ManufacturerCode)<>5) Or (Len(NumberSystem)=3 And Len(ManufacturerCode)<>4)
    Debug "Bad Number"
    ProcedureReturn 0
  EndIf
  ;Test Check Digit:
  out.s=NumberSystem+ManufacturerCode+ProductCode
  For x.b=1 To 12:t.b=~x&1
    CheckDigitShouldbe.l+Val(Mid(out,x,1))*Pow(3,t)
  Next
  CheckDigitShouldbe.l=10-CheckDigitShouldbe.l%10
  If CheckDigitShouldbe<>Val(CheckDigit)
    Debug "Bad Checksum"
    ProcedureReturn 0
  EndIf
  NumberSystem=Left(out,2):ManufacturerCode=Mid(out,3,5)
  ; *** Barcode Digits ***
  ; Rigth Digits:
  Dim digitsr.s(9)
  digitsr(0)="1110010"
  digitsr(1)="1100110"
  digitsr(2)="1101100"
  digitsr(3)="1000010"
  digitsr(4)="1011100"
  digitsr(5)="1001110"
  digitsr(6)="1010000"
  digitsr(7)="1000100"
  digitsr(8)="1001000"
  digitsr(9)="1110100"
  ; Left Digits Odd:
  Dim digitslodd.s(9)
  digitslodd(0)="0001101"
  digitslodd(1)="0011001"
  digitslodd(2)="0010011"
  digitslodd(3)="0111101"
  digitslodd(4)="0100011"
  digitslodd(5)="0110001"
  digitslodd(6)="0101111"
  digitslodd(7)="0111011"
  digitslodd(8)="0110111"
  digitslodd(9)="0001011"
  ; Left Digits Even:
  Dim digitsleven.s(9)
  digitsleven(0)="0100111"
  digitsleven(1)="0110011"
  digitsleven(2)="0011011"
  digitsleven(3)="0100001"
  digitsleven(4)="0011101"
  digitsleven(5)="0111001"
  digitsleven(6)="0000101"
  digitsleven(7)="0010001"
  digitsleven(8)="0001001"
  digitsleven(9)="0010111"
  ; *** CONVERSION ***
  out.s="101" ; <- Left sentinel
  out.s+digitslodd(Val(Right(NumberSystem,1)))
  Select Left(NumberSystem,1)
  Case "0"
    out.s+digitslodd(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,5,1)))
  Case "1"
    out.s+digitslodd(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,5,1)))
  Case "2"
    out.s+digitslodd(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,5,1)))
  Case "3"
    out.s+digitslodd(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,5,1)))
  Case "4"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,5,1)))
  Case "5"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,5,1)))
  Case "6"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,5,1)))
  Case "7"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,5,1)))
  Case "8"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,5,1)))
  Case "9"
    out.s+digitsleven(Val(Mid(ManufacturerCode,1,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,2,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,3,1)))
    out.s+digitsleven(Val(Mid(ManufacturerCode,4,1)))
    out.s+digitslodd(Val(Mid(ManufacturerCode,5,1)))
  EndSelect
  out.s+"01010"  ; Middle bars
  For x.b=1 To 5
    out.s+digitsr(Val(Mid(ProductCode,x,1)))
  Next
  out.s+digitsr(Val(CheckDigit)) ; <- checkdigit
  out.s+"101" ; Right sentinel
  ; *** DRAWING ***
  width=(Len(out)+size*2)*size:height=width/2
  CreateImage(0,width,height)
  StartDrawing(ImageOutput(0))
    Box(0,0,width,height,$ffffff)
    For x.b=1 To Len(out)
      If Mid(out,x,1)="0"
        color=$ffffff
      ElseIf Mid(out,x,1)="1"
        color=$000000
      EndIf
      If x<4 Or x>Len(out)-4 Or (x>Len(out)/2-2 And x<Len(out)/2+3)
        Box(size*(x+size-1),size*2,size,height-4*size,color)
      Else
        Box(size*(x+size-1),size*2,size,height-8*size,color)
      EndIf
    Next
  StopDrawing()
  SaveImage(0,target+".bmp")
  FreeImage(0)
  ProcedureReturn 1
EndProcedure
;Example:
EAN13barcode("54","49000","00099","6",2,"c:\EAN13_BARCODE")

Posted: **Wed May 03, 2006 10:09 pm**

or you could use some of my libs

Code 128
Code 93
Code 39 / Code 39 Full
EAN13
EAN8
UPCA
UPCE
Code 2 of 5 Standard / Code 2 of 5 Interleaved
Codabar
2 Digit Supplement
5 Digit Supplement

Posted: **Wed May 03, 2006 10:25 pm**

Nice.

Are all it tested and well done ?

What about 2D ones ??

Posted: **Wed May 03, 2006 10:32 pm**

of course i did tests

; PrintBarcode V1.02
; Made by ABBKlaus 1/2006-3/2006
;
;
; tested with the following scanners :
;
; Datalogic Gryphon M100
; Datalogic DLL5510-M
; Datalogic FireScan D131
; Symbol P302 FZY

PS : when you deliver the information for the 2-D codes it could implement these too

Posted: **Wed May 03, 2006 10:32 pm**

By the way i have a doubt.
the help say:

barcode
12-Digits EAN-13 code
the 13th-Digit is the checkdigit

But when the country code is 3 digits instead of one, the total digits are 1 more, i.e. 14.

Posted: **Wed May 03, 2006 10:39 pm**

i get my information of these codes from here if this is of any help to you http://www.barcodeisland.com/ean13.phtml