87 - netherlands 10400 - Albert Heijn 16339 - Fruit drink orange-peach 8 - check digitHave 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] }