UPC BARCODE

Share your advanced PureBasic knowledge/code with the community.
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

UPC BARCODE

Post by Num3 »

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")
Seldon
Enthusiast
Enthusiast
Posts: 405
Joined: Fri Aug 22, 2003 7:12 am
Location: Italia

Post by Seldon »

Thanks for sharing.
Pandora
New User
New User
Posts: 3
Joined: Tue Oct 21, 2003 6:27 am

Post by Pandora »

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 ?
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

Post by Num3 »

I'm currently studing several barcode standars and i'll be sharing the code has i progress...
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

Post by Num3 »

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...
Pandora
New User
New User
Posts: 3
Joined: Tue Oct 21, 2003 6:27 am

Post by Pandora »

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
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:

Post by Num3 »

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 :mrgreen:
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 :P 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 :D
USCode
Addict
Addict
Posts: 924
Joined: Wed Mar 24, 2004 11:04 pm
Location: Seattle

Post by USCode »

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?
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

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")
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

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")
Last edited by Psychophanta on Thu May 04, 2006 12:10 am, edited 1 time in total.
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

or you could use some of my libs :arrow:
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

Image
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Nice. :)
Are all it tested and well done ? :wink:

What about 2D ones ?? :P
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

of course i did tests :shock:
; 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 :)
Last edited by ABBKlaus on Wed May 03, 2006 10:34 pm, edited 1 time in total.
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

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.
:?
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
ABBKlaus
Addict
Addict
Posts: 1143
Joined: Sat Apr 10, 2004 1:20 pm
Location: Germany

Post by ABBKlaus »

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