Allgemeine Fragen zur PROFAN Programmierung
Views (Heute): 243060 (4496)
  Suchen
 Zurück zur Übersicht
 AutorThema: Barcode
Eike Fremy
Datum:10.04.02 08:41 Antwortenals Email verschicken (eike-fremy@t-online.de) 


Hallo Profan Freunde
kann ich mit Profan 4.5 ein Barcode drucken ????



Thorsten
Datum: 10.04.02 08:50 Antwortenals Email verschicken (mrk@mrk-soft.de) 


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



 Zurück zur Übersicht