PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Barcode Scanner [Windows]

https://www.purebasic.fr/german/viewtopic.php?t=24032

Seite 1 von 1

Barcode Scanner [Windows]

Verfasst: 14.03.2011 16:27
von Mr.L
Nachdem kürzlich der Barcode Generator von "125" vorgestellt wurde, habe ich
mal angefangen einen Barcode Scanner zu schreiben.
Er funktioniert auch, solange der zu scannende Barcode in möglichst guter Qualität vorliegt (d.h. scharfe Ränder, nicht verwaschen)
Bislang sind die Typen "Code 39", "Code 128" und GTIN (EAN-8 und EAN-13) implementiert.

So geht's:
- passenden Typen aus der Combobox auswählen
- Mauszeiger vor den Barcode setzen und "STRG"-Taste drücken (gedückt halten)
- Mauszeiger hinter den Barcode setzen und "STRG"-Taste loslassen

Ist das Resultat falsch kann man mit den Schiebern "Skalierungsfaktor" und "Schwellenwert" das Ergebnis beeinflussen.

Auch wenn das Ganze evtl. keinen besonders großen Nutzen hat, so habe ich doch einiges über das Thema gelernt,
und Barcodes begegnen uns im Alltag ja praktisch überall.

hier etwas zum probieren:

Code 128 (mit 125's Barcodegenerator erstellt):
Bild

Code 39
Bild

GTIN 13
Bild

GTIN 8
Bild

Code: Alles auswählen

EnableExplicit

Structure Code
	code$
	char.s[4]	
	type.l[4]
	value.l
EndStructure

Global NewList Code039.Code()
Global NewList Code128.Code()
Global NewList CodeGTIN.Code()
Define l , char$ , code$ , result$
Define hwnd , hdc , keyDown , p1.Point , p2.Point

Restore Data_Code039
For l = 0 To 43
	Read.s code$
	AddElement(Code039())
	Code039()\code$		= code$
	Code039()\value		= l
	Select l
		Case 00 To 09	: Code039()\char[1] = Chr(l + 48)
		Case 10 To 35	: Code039()\char[1] = Chr(l + 55)
		Case 36					: Code039()\char[1] = "-"
		Case 37					: Code039()\char[1] = "."
		Case 38					: Code039()\char[1] = " "
		Case 39					: Code039()\char[1] = "$"
		Case 40					: Code039()\char[1] = "/"
		Case 41					: Code039()\char[1] = "+"
		Case 42					: Code039()\char[1] = "%"
		Case 43					: Code039()\char[1] = "*"
	EndSelect
Next

Restore Data_Code128
For l = 0 To 106
	Read.s code$
	AddElement(Code128())
	Code128()\code$		= code$
	Code128()\value		= l
	Select l
		Case 0 To 63
			Code128()\char[1] = Chr(l + 32)
			Code128()\char[2] = Chr(l + 32)
		Case 64 To 95
			Code128()\char[1] = Chr(l - 64)
			Code128()\char[2] = Chr(l + 32)
		Case 98
			Code128()\type[1] = 2
			Code128()\type[2] = 1
		Case 99
			Code128()\type[1] = 3
			Code128()\type[2] = 3
		Case 100
			Code128()\type[1] = 2
		Case 101
			Code128()\type[2] = 1
			Code128()\type[3] = 1
		Case 103 To 105
			Code128()\type[1] = l - 102
			Code128()\type[2] = l - 102
			Code128()\type[3] = l - 102
	EndSelect
	If l < 100
		Code128()\char[3] = RSet(Str(l),2,"0")
	EndIf
Next

Restore Data_GTIN
For l = 0 To 20
	Read.s code$
	AddElement(CodeGTIN())
	CodeGTIN()\code$		= code$
	If l < 20
		CodeGTIN()\char[1]	= Chr((l/2) + 48)
		CodeGTIN()\value		= (l % 2)
	EndIf
Next

Procedure.s ScanlineToString(hdc, x0,y0,x1,y1 , threshold , scaleFactor.d)
	
	Protected result$
	Protected dx.d,dy.d,rgb,col
	Protected t,scanLineLength,sCount,sValue,count
	Protected lastCol,lShort,lWide
	
	If (x0=x1 And y0=y1)
		ProcedureReturn ""
	EndIf	
	
	; move along the scanline and get the min and max barwidth
 	dx							= x1 - x0
	dy							= y1 - y0
	scanLineLength	= Sqr(dx*dx + dy*dy)
	Protected Dim ScanLine(scanLineLength)
	
	rgb			= GetPixel_(hdc , x0 , y0)
	lastCol	= (Red(rgb) + Green(rgb) + Blue(rgb)) / 3.0
	lShort	=  999
	lWide		= -999

	For t = 0 To scanLineLength - 1
		x1 = x0 + (dx / scanLineLength) * t
		y1 = y0 + (dy / scanLineLength) * t
		rgb = GetPixel_(hdc , x1 , y1)
		col = (Red(rgb) + Green(rgb) + Blue(rgb)) / 3.0

		count + 1
		If Abs(col - lastCol) > threshold
			lastCol = col
			If sCount > 0
				If count < lShort
					lShort = count
				EndIf
				If count > lWide
					lWide = count
				EndIf							
				ScanLine(sCount) = count
			EndIf
			sCount + 1
			count = 0
		EndIf
	Next

	For t = 1 To sCount - 1
		count = ScanLine(t) * (scaleFactor / lWide)
		result$ + Str(count)
	Next
	 	
 	ProcedureReturn result$
	
EndProcedure

Procedure FindBestMatch(List code.Code() , text$ , pos)
	Protected l , *bestMatch = #Null , difference , error , maxError = 999
	
	ForEach code()
		error = 0
		For l = 1 To Len(code()\code$)
			difference = Abs( Val(Mid(code()\code$,l,1)) - Val(Mid(text$, pos + l - 1 , 1)))
			error + difference * difference
		Next
		If (error < maxError)
			maxError = error
			*bestMatch = code()
			If error = 0
				Break
			EndIf
		EndIf
	Next
	
	ProcedureReturn *bestMatch
	
EndProcedure

Procedure.s Decode_Code39(scanLineString$)
 	
	Protected *code.Code , result$ , pos = 1 , checkSum , lastCheckSum , lastCodeVal
	
	StatusBarText(0,1,"")
; 	
	Repeat
		*code = FindBestMatch(Code039() , scanLineString$ ,pos)
		If *code <> #Null
			pos + Len(*code\code$)
			result$ + *code\char[1]
			If *code\char[1] <> "*"
				lastCodeVal		= *code\value
				lastCheckSum	= checkSum
				checkSum + *code\value
			EndIf
		Else
			pos + 1
			result$ + "?"
			StatusBarText(0,1,"Error")
		EndIf
	Until pos > Len(scanLineString$) - 1
	
	If (lastCheckSum % 43) = lastCodeVal
		StatusBarText(0,1,"Checksum OK")
	Else
		StatusBarText(0,1,"Checksum Error")
	EndIf
	
	ProcedureReturn result$
	
EndProcedure

Procedure.s Decode_Code128(scanLineString$)
	
	Protected *code.Code , result$ , pos = 1 , type = 1 , checksum , checksumWeight = 1 , lastCheckSum , lastCodeVal
	
	StatusBarText(0,1,"")
		
	Repeat
		*code = FindBestMatch(Code128() , scanLineString$ , pos)
		If *code <> #Null			
			Select *code\value				
				Case 98 To 105
					If *code\type[type]
						type = *code\type[type]					
					EndIf
				Case 106 :Break
				Default
					If pos < Len(scanLineString$) - 13
						result$ + *code\Char[type]
					EndIf
			EndSelect
			If pos > 12 : checksumWeight + 1 : EndIf
			lastCodeVal		= *code\value
			lastCheckSum	= checkSum
			checkSum + *code\value * checksumWeight
			pos + Len(*code\code$)
		Else
			pos + 1
			result$ + "?"
			StatusBarText(0,1,"Error")
		EndIf
	Until pos > Len(scanLineString$) - 1

	If (lastCheckSum % 103) = lastCodeVal
		StatusBarText(0,1,"Checksum OK")
	Else
		StatusBarText(0,1,"Checksum Error")
	EndIf
	
	ProcedureReturn result$
	
EndProcedure

Procedure.s Decode_GTIN(scanLineString$)
	
	Protected *code.Code , result$ , pos = 1 , checkSum , markerCount , firstVal , parity$ , checksumWeight = 1
	
	StatusBarText(0,1,"")

	Repeat
		*code = FindBestMatch(CodeGTIN() , scanLineString$ , pos)
		If *code <> #Null
			Select *code\code$					
				Case "111"
					markerCount + 1
					If markerCount = 2
						pos + 2
					EndIf
				Default
					result$ + *code\char[1]
					checksumWeight = 4 - checksumWeight
					checkSum + (Val(*code\char[1]) * checksumWeight)				
					If markerCount < 2
						parity$ + Str(*code\value)
						Select parity$
							Case "000000"	: firstVal = 1
							Case "001011"	: firstVal = 2
							Case "001101"	: firstVal = 3
							Case "001110"	: firstVal = 4
							Case "010011"	: firstVal = 5
							Case "011001"	: firstVal = 6
							Case "011100"	: firstVal = 7
							Case "010101"	: firstVal = 8
							Case "010110"	: firstVal = 9
							Case "011010"	: firstVal = 10
						EndSelect
						If firstVal
							result$ = Str(firstVal - 1) + result$
							checksum + (firstVal - 1)
						EndIf
					EndIf
			EndSelect
			pos + Len(*code\code$)
		Else
			pos + 1
			result$ + "?"
			StatusBarText(0,1,"Error")
		EndIf
	Until pos > Len(scanLineString$) - 1
	
	If checksum  % 10 = 0
		StatusBarText(0,1,"Checksum OK")							
	Else
		StatusBarText(0,1,"Checksum Error")
	EndIf
	ProcedureReturn result$
	
EndProcedure

Procedure.s StartScan(hdc , x0,y0 ,x1,y1 , codeType , threshold , scaleFactor.d)
	
	Protected scanLineString$ , result$
	
	If hdc = 0 : ProcedureReturn : EndIf
	
	scanLineString$ = ScanlineToString(hdc , x0,y0 ,x1,y1 , threshold , scaleFactor)
	Select codeType
		Case 0	: result$ = Decode_Code39(scanLineString$)
		Case 1	: result$ = Decode_Code128(scanLineString$)		
		Case 2	: result$ = Decode_GTIN(scanLineString$)			
	EndSelect
	
	SetGadgetText(0 , result$)
	
	ProcedureReturn result$
	
EndProcedure

OpenWindow(0,0,0,320,120,"Barcode Scanner")
StickyWindow(0,1)
CreateStatusBar(0,WindowID(0))
AddStatusBarField(210)
AddStatusBarField(110)
StringGadget	(0,110, 5,200,25,"")
ComboBoxGadget(1, 10, 5, 85,25)
AddGadgetItem	(1,0,"Code 39")
AddGadgetItem	(1,1,"Code 128")
AddGadgetItem	(1,2,"GTIN")
SetGadgetState(1,1)
TrackBarGadget(2,130,40,180,20,1,99)
SetGadgetState(2,40)
TextGadget		(3, 10,40,120,20,"Skalierungsfaktor: " + StrF( GetGadgetState(2) / 10.0 , 3))
TrackBarGadget(4,130,70,180,20,0, 255)
SetGadgetState(4,128)
TextGadget		(5, 10,70,120,20,"Schwellenwert: " + Str( GetGadgetState(4)))

StatusBarText(0,0,"1. Punkt wählen und STRG drücken",#PB_StatusBar_Center)

Repeat
	If GetAsyncKeyState_(#VK_CONTROL) & $8000		
		If keyDown = 0
			keyDown = 1
			StatusBarText(0,0,"2. Punkt wählen und STRG loslassen",#PB_StatusBar_Center)			
			GetCursorPos_(p1)
		EndIf
	Else
		If keyDown = 1
			keyDown = 0
			StatusBarText(0,0,"1. Punkt wählen und STRG drücken",#PB_StatusBar_Center)			
			GetCursorPos_(p2)
			hwnd = WindowFromPoint_(PeekQ(p1))
			If hwnd
				hdc = GetDC_(hwnd)
				If hdc
					If ScreenToClient_(hwnd , p1)  And ScreenToClient_(hwnd , p2)
						StartScan(hdc , p1\x,p1\y , p2\x,p2\y , GetGadgetState(1) , GetGadgetState(4) , GetGadgetState(2) / 10.0)						
					EndIf
				EndIf
			EndIf
		EndIf
	EndIf
	Select WaitWindowEvent(25)
		Case #PB_Event_CloseWindow
			End
		Case #PB_Event_Gadget
			SetGadgetText(3,"Skalierungsfaktor: " + StrF( GetGadgetState(2) / 10.0 , 3))
			SetGadgetText(5,"Schwellenwert: " + Str( GetGadgetState(4)))
			StartScan(hdc , p1\x,p1\y , p2\x,p2\y , GetGadgetState(1) , GetGadgetState(4) , GetGadgetState(2) / 10.0)
	EndSelect
ForEver

DataSection
Data_Code039:
	Data.s "1113313111","3113111131","1133111131","3133111111","1113311131"
	Data.s "3113311111","1133311111","1113113131","3113113111","1133113111"
	Data.s "3111131131","1131131131","3131131111","1111331131","3111331111"
	Data.s "1131331111","1111133131","3111133111","1131133111","1111333111"
	Data.s "3111111331","1131111331","3131111311","1111311331","3111311311"
	Data.s "1131311311","1111113331","3111113311","1131113311","1111313311"
	Data.s "3311111131","1331111131","3331111111","1311311131","3311311111"
	Data.s "1331311111","1311113131","3311113111","1331113111","1313131111"
	Data.s "1313111311","1311131311","1113131311","1311313111"
Data_Code128:	
	Data.s "212222","222122","222221","121223","121322","131222","122213"
	Data.s "122312","132212","221213","221312","231212","112232","122132"
	Data.s "122231","113222","123122","123221","223211","221132","221231"
	Data.s "213212","223112","312131","311222","321122","321221","312212"
	Data.s "322112","322211","212123","212321","232121","111323","131123"
	Data.s "131321","112313","132113","132311","211313","231113","231311"
	Data.s "112133","112331","132131","113123","113321","133121","313121"
	Data.s "211331","231131","213113","213311","213131","311123","311321"
	Data.s "331121","312113","312311","332111","314111","221411","431111"
	Data.s "111224","111422","121124","121421","141122","141221","112214"
	Data.s "112412","122114","122411","142112","142211","241211","221114"
	Data.s "413111","241112","134111","111242","121142","121241","114212"
	Data.s "124112","124211","411212","421112","421211","212141","214121"
	Data.s "412121","111143","111341","131141","114113","114311","411113"
	Data.s "411311","113141","114131","311141","411131"
	Data.s "211412","211214","211232","2331112"
Data_GTIN:
	Data.s "3211","1123" , "2221","1222" , "2122","2212" , "1411","1141" , "1132","2311"
	Data.s "1231","1321" , "1114","4111" , "1312","2131" , "1213","3121" , "3112","2113"
	Data.s "111"
EndDataSection

Re: Barcode Scanner [Windows]

Verfasst: 26.03.2011 14:31
von zigapeda
wow, sehr nett und vorallem eine ausergewoehnliche idee sowas als software zu realisieren :allright:

Re: Barcode Scanner [Windows]

Verfasst: 26.03.2011 15:07
von Kiffi
Schöne Sache das! :D Danke! :allright:

Grüße ... Kiffi

Re: Barcode Scanner [Windows]

Verfasst: 26.03.2011 20:13
von c4s
...vorallem ein sehr gut funktionierendes Beispiel. :allright:

Re: Barcode Scanner [Windows]

Verfasst: 25.04.2011 14:35
von mk-soft
:allright:

Re: Barcode Scanner [Windows]

Verfasst: 25.04.2011 16:13
von RSBasic
Funktioniert gut. Bild

Re: Barcode Scanner [Windows]

Verfasst: 04.08.2011 17:50
von kwai chang caine
Giant, erstaunliche :shock:
Vielen Dank für die gemeinsame Nutzung 8)

Re: Barcode Scanner [Windows]

Verfasst: 04.10.2013 00:15
von funkheld
Hmm..., sehr interessant.

Wie wird der Code eigentlich eingescannt. Das versteh ich nicht.
Wieso vom Bildschirm ? Den StrichCode den ich geschrieben habe wird 100%tig wiedererkannt....sprachlos.
Mit einer optischen Maus ja aber nur mit einem Mauspfeil auf den Bildschirm... :D

Danke.

Gruss
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de