Ja, das geht sogar mit 4.5
'ean13 code erstellen
declare EAn13$,EANCODE$,Codier$,zeichen%,zeichen$,zähler%
declare Ungerade%,Gerade%,Prfziffer%,Prüfen%,x1%,x2%,y1%,y2%
Proc EAnPrüfen
ean13$ = mid$(ean13$,1,12)
Let Zähler% =1
let Gerade% =0
let Ungerade% =0
Let Prfziffer%=""
whilenot equ(Zähler%,13)
Let Ungerade%=add(Ungerade%,val(Mid$(EAN13$,Zähler%,1)))
let Zähler%=add(Zähler%,2)
endwhile
let Zähler%=2
whilenot equ(Zähler%,14)
Let Gerade%=add(Gerade%,val(Mid$(EAN13$,Zähler%,1)))
let Zähler%=add(Zähler%,2)
endwhile
Let Gerade%=@Mul(Gerade%,3)
Let zähler%=@add(Gerade%,Ungerade%)
let PRfziffer%=@sub(10,val(mid$(zähler%,Len(Zähler%),1)))
' let PRfziffer%=@sub(10,val(mid$(zähler%,Len(Zähler%)),1))
case equ(Prfziffer%,10): Let Prfziffer%=0
endproc
Proc Zeichensatz_A
case equ(zeichen%,0): let zeichen$= "0001101"
case equ(zeichen%,1): let zeichen$= "0011001"
case equ(zeichen%,2): let zeichen$= "0010011"
case equ(zeichen%,3): let zeichen$= "0111101"
case equ(zeichen%,4): let zeichen$= "0100011"
case equ(zeichen%,5): let zeichen$= "0110001"
case equ(zeichen%,6): let zeichen$= "0101111"
case equ(zeichen%,7): let zeichen$= "0111011"
case equ(zeichen%,8): let zeichen$= "0110111"
case equ(zeichen%,9): let zeichen$= "0001011"
endproc
PRoc Zeichensatz_B
case equ(zeichen%,0): let zeichen$= "0100111"
case equ(zeichen%,1): let zeichen$= "0110011"
case equ(zeichen%,2): let zeichen$= "0011011"
case equ(zeichen%,3): let zeichen$= "0100001"
case equ(zeichen%,4): let zeichen$= "0011101"
case equ(zeichen%,5): let zeichen$= "0111001"
case equ(zeichen%,6): let zeichen$= "0000101"
case equ(zeichen%,7): let zeichen$= "0010001"
case equ(zeichen%,8): let zeichen$= "0001001"
case equ(zeichen%,9): let zeichen$= "0010111"
endproc
Proc Zeichensatz_C
case equ(zeichen%,0): let zeichen$= "1110010"
case equ(zeichen%,1): let zeichen$= "1100110"
case equ(zeichen%,2): let zeichen$= "1101100"
case equ(zeichen%,3): let zeichen$= "1000010"
case equ(zeichen%,4): let zeichen$= "1011100"
case equ(zeichen%,5): let zeichen$= "1001110"
case equ(zeichen%,6): let zeichen$= "1010000"
case equ(zeichen%,7): let zeichen$= "1000100"
case equ(zeichen%,8): let zeichen$= "1001000"
case equ(zeichen%,9): let zeichen$= "1110100"
endproc
Proc 13Zeichen
case equ(zeichen%,0): let Codier$= "AAAAAA"
case equ(zeichen%,1): let Codier$= "AABABB"
case equ(zeichen%,2): let Codier$= "AABBAB"
case equ(zeichen%,3): let Codier$= "AABBBA"
case equ(zeichen%,4): let Codier$= "ABAABB"
case equ(zeichen%,5): let Codier$= "ABBAAB"
case equ(zeichen%,6): let Codier$= "ABBBAA"
case equ(zeichen%,7): let Codier$= "ABABAB"
case equ(zeichen%,8): let Codier$= "ABABBA"
case equ(zeichen%,9): let Codier$= "ABBABA"
endproc zeichen%
PROC RAndzeichen
Let zeichen$="101"
ENDPROC
Proc Trennzeichen
Let zeichen$="01010"
endproc
proc zeichnen
parameters ppx%, ppy%
randzeichen
let EANCODE$=ADD$(EANCODE$,Zeichen$)
let Zähler%=1
whilenot equ(zähler%,7)
Let zeichen%=val(Mid$(EAN13$,Add(Zähler%,1),1))
if equ$(mid$(Codier$,zähler%,1),"A")
Zeichensatz_A
'print "Zeichensatz A ";Zeichen%;" ";Zeichen$
endif
if equ$(Mid$(codier$,Zähler%,1),"B")
Zeichensatz_B
'print "Zeichensatz B ";Zeichen%;" ";Zeichen$
endif
let EANCODE$=add$(EANCODE$,Zeichen$)
inc Zähler%
wend
rem print "Linker Block mit Randzeichen ";len(EANCODE$)
Trennzeichen
Let EANCODE$=add$(EANCODE$,Zeichen$)
rem print "Linker Block mit Ran. und Trennzeichen "; Len(EANCODE$)
let Zähler%=8
whilenot equ(zähler%,14)
Let zeichen%=val(Mid$(EAN13$,Zähler%,1))
Zeichensatz_C
'Print "Zeichensatz C ";Zeichen%;" ";Zeichen$
let EANCODE$=add$(EANCODE$,Zeichen$)
inc Zähler%
wend
randzeichen
let EANCODE$=add$(EANCODE$,Zeichen$)
rem print EANCODE$
let Zähler%=1
let x1%=ppx%
let x2%=ppx%
let Y1%=ppy% + 30
let y2%=ppy%
'let Y1%=380
'let y2%=410
whilenot equ(Zähler%,96)
Let zeichen%= val(mid$(EANCODE$,Zähler%,1))
if equ(zeichen%,1)
usepen 0,1,@rgb(0,0,0)
line x1%,y1%-x2%,y2%
endif
let x1%=add(x1%,1)
let x2%=add(x2%,1)
inc zähler%
wend
usefont "arial",14,6,0,0,0
drawtext 1+ppx%,32+ppy%,EAN13$
endproc
proc makebarcode '12 stelliger Bar-code, x pos, y-pos auf screen
parameters ean13$, mmx%, mmy%
' StartPrint
Eancode$ = ""
EANprüfen
ean13$ = mid$(ean13$,1,12) + str$(prfziffer%)
let zeichen%=val(mid$(EAN13$,1,1))
13zeichen
zeichnen mmx%,mmy%
' EndPrint
endproc
' ------------------------
cls
makebarcode "046913457012" ,90,100
waitkey
einfach unten die proc makebarcode aufrufen, und schon
wird dieser erstellt. startprint und endprint
aktivieren, und es wird ausgedruckt.
Thorsten
|