87 - netherlands 10400 - Albert Heijn 16339 - Fruit drink orange-peach 8 - check digit
Have fun -- Pascal. #EAN 13 encoding routines.
#A complete description of EAN-13 barcodes can be found on
# http://www.barcodeisland.com/ean13.phtml
#The EAN13 check sum is calculated by taking the first twelve
#digits of the barcode (the 13th will be the check digit)
#Take all odd number digits (the first digit is odd) add them up
#and multiply by 3. Add to that the sum of the remaining six even positions
#The checkdigit is an inverted modulo 10. Eaxample: If the total sum is 87
#how much must I add to get to the next multiple of ten (90) which is
#three. Making the check digit '3'.
proc ean13_csum { number } {
set odd 1
set sum 0
foreach digit [split $number ""] {
set odd [expr {!$odd}]
puts "$sum += ($odd*2+1)*$digit :: [expr {($odd*2+1)*$digit}]"
incr sum [expr {($odd*2+1)*$digit}]
}
set check [expr {$sum % 10}]
if { $check > 0 } {
return [expr {10 - $check}]
}
return $check
}
proc ean13 { number } {
if { [string length $number] < 12 } {
error "Not enough digits, need 12 or 13."
}
#EAN13 digits, the ones represent black bars, the zeroes white space.
#Three pairs of digits: lefthand-odd(A), lefthand-even(B) and righthand
set digits {
{0 0001101 0100111 1110010}
{1 0011001 0110011 1100110}
{2 0010011 0011011 1101100}
{3 0111101 0100001 1000010}
{4 0100011 0011101 1011100}
{5 0110001 0111001 1001110}
{6 0101111 0000101 1010000}
{7 0111011 0010001 1000100}
{8 0110111 0001001 1001000}
{9 0001011 0010111 1110100}
}
#The first digit of the ean13 code is encoded in the parity of
#characters 2 through 7, using this table. Note that the ones and twos
#are just list indices to the digits table above.
array set parity_enc {
0 {1 1 1 1 1}
1 {1 2 1 2 2}
2 {1 2 2 1 2}
3 {1 2 2 2 1}
4 {2 1 1 2 2}
5 {2 2 1 1 2}
6 {2 2 2 1 1}
7 {2 1 2 1 2}
8 {2 1 2 2 1}
9 {2 2 1 2 1}
}
#If we get a twelve digit number, append the checkdigit to that:
if { [string length $number] == 12 } {
set number $number[ean13_csum $number]
}
#All EAN13 codes start with 'left guard bars':
lappend bars 101
#second 'system' char, encoded as a lefthand-odd character:
lappend bars [lindex [lindex $digits [string index $number 1]] 1]
#the five digits that encode the first 'system' digit in their parity:
foreach digit [split [string range $number 2 6] ""] \
enc $parity_enc([string index $number 0]) {
lappend bars [lindex [lindex $digits $digit] $enc]
}
#center guard bars:
lappend bars 01010
#the right hand chars, all encoded the same:
for {set i 7} {$i<13} {incr i} {
lappend bars [lindex [lindex $digits [string index $number $i]] 3]
}
#and the final guards:
lappend bars 101
return [list $bars $number]
}
# Tk demo code:
package require Tk
wm title . "EAN-13 Barcode"
label .lbar -text "Barcode"
entry .barcode -textvariable barcode -width 15
button .show -text show -command do_display
grid .lbar .barcode .show -sticky nw
canvas .c -width 200 -height 100
grid x .c - -sticky nw
proc do_display { } {
global barcode
if { [string length $barcode] < 12 } {
return
}
.c delete all
set b [ean13 $barcode]
set x 25
foreach barset [lindex $b 0] {
set bars [split $barset ""]
if {[llength $bars] == 7} {
set len 40
} else {
set len 46
}
foreach bar $bars {
incr x 1
if { $bar } {
.c create line $x 15 $x [expr $len+15]
}
}
}
#And create the human readable text below it:
.c create text 21 60 -text [string index [lindex $b 1] 0]
.c create text 49 60 -text [string range [lindex $b 1] 1 6]
.c create text 95 60 -text [string range [lindex $b 1] 7 12]
}
set barcode {8710400163398}
do_display
}kroc 11 Oct 2004 : If you want to do EAN8 barcodes too, you should replace [ean13_csum] by this one:
proc ean13_csum { number } {
set C 0
if {[string length $number]%2 != 0} {
set number 0$number
}
foreach { I P } [split $number {}] {
set C [expr $C + (3 * $P) + $I]
}
return [string index [expr 10-$C%10] end]
}
