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):
Code 39
GTIN 13
GTIN 8
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
Danke! 
