Zurück zur Homepage

Barcode

Laut Wiki wird Barcode folgendermaßen beschrieben:

Als Strichcode, Balkencode oder Barcode (engl. bar für Balken) wird eine optoelektronisch lesbare Schrift bezeichnet, die aus verschieden breiten, parallelen Strichen und Lücken besteht. Diese Bezeichnung wurde gewählt, obwohl es sich nicht um einen Code handelt. Die Daten in einem Strichcode werden mit optischen Lesegeräten, wie z. B. Barcodelesegeräten (Scanner) oder Kameras, maschinell eingelesen und elektronisch weiterverarbeitet.

Auswerten von Bildern, welche Barcode enthalten

Wie die vorherigen Beispiele gezeigt haben, ist es ohne weiteres möglich, Bilder per Twain-Schnittstelle einzulesen, diese Bilder zu skalieren und zu drehen. Mit einer Webcam oder von anderen Twainquellen kann man beispielsweise Bilder einlesen, die einen Barcode enthalten. Es wäre natürlich toll, wenn man solche Bilder auch auswerten könnte. Das soll in diesem Beispiel gemacht werden und zwar ohne die Hilfe fremder Programme.

Ausgewertet werden in diesem Beispiel die zwei wohl gebräuchlichsten Barcodetypen EAN 13 und Code 39. Der Barcode EAN 13 enthält, wie es der Name bereits andeutet, insgesamt 13 Ziffern, darunter befindet sich auch eine Prüfziffer. Code 39 ist ein alphanumerischer Code, man kann mit ihm also neben Zahlen auch Texte darstellen, ein optionales Prüfzeichen zum Erkennen von Lesefehlern ist ebenso möglich.

Um so etwas zu realisieren, müssen mehrere Hürden überwunden werden. Zum Einen muss man erst einmal an die Pixel eines Bildes vom Typ IPictureDisp bzw. StdPicture kommen, was noch recht einfach zu realisieren ist. StdPicture ist das Format, was von OLE benutzt wird. Jetzt stellt sich natürlich gleich die Frage, warum es gerade dieses Format sein muss. Nun, dieses Format wird von Office und anderen OLE-fähigen Programmen intensiv genutzt, eingebettete oder verknüpfte Bilder, sowie Hintergründe von Steuerelementen werden intern in diesem Format gespeichert. Dabei steht jedes Bild, egal aus welcher Quelle geladen, als Bitmap zur Verfügung, selbst wenn es vorher komprimiert war.

Das hat den Vorteil, dass man sich nicht um unterschiedliche Formate scheren muss, ein beliebiges Bild, welches man mit LoadPicture in den Speicher geladen oder als Grafik eingefügt hat, kann man immer mit der gleichen Methode bearbeiten. Es ist auch unerheblich, wie groß oder verzerrt ein Bild dargestellt wird, intern wird immer das Bild im Bitmap-Format und der Originalgröße gespeichert

Weiterhin sollte das Auswerten in einer annehmbaren Zeit erfolgen. Dem steht das Problem gegenüber, dass man meist hochauflösende Bilder verwenden muss. Zumindest wird eine so hohe Auflösung benötigt, dass ein Balken, bzw. eine Lücke eine gewisse Mindestbreite besitzt, so dass man auch kleinere Scanfehler ausgleichen kann. Solche Bilder enthalten naturgemäß sehr viele Bildpunkte und wenn man jeden einzelnen Pixel ansprechen will, erfordert das viel Zeit.

Ein weiteres Problem ist, dass solche Barcodes auch nicht immer in Schwarzweiß vorliegen. Ein Balken kann beispielsweise schwarz sein, also den RGB-Wert RGB(0,0,0) besitzen, er kann aber auch den Grauwert RGB(20,20,20) haben. Auch farbige Hintergründe sind möglich, benötigt werden aber eigentlich nur zwei Informationen, Balken oder Hintergrundfarbe. Das vorliegende Bild wird also vor der Auswertung in ein Schwarzweißbild, bzw. in ein zweidimensionales Array mit den entsprechenden Informationen umgewandelt.

Erschwerend kommt noch hinzu, dass der in einem gescannten Bild steckende Barcode nicht immer exakt horizontal oder vertikal ausgerichtet ist. Besitzt ein Balken beispielsweise nur zwei, drei Pixel an Dicke, kann schon eine kleine Abweichung von der Horizontalen oder Vertikalen dazu führen, dass eine Auswertung nahezu unmöglich wird. Man könnte jetzt die Pixel so durchlaufen, dass man ausgehend von jeden Punkt geradlinig in alle Richtungen scannt, das stelle ich mir aber enorm zeitaufwendig und kompliziert vor.

Um so etwas zu umgehen, drehe ich lieber das Bild und verwende jedesmal die gleiche Funktion zur Auswertung. Dabei wird aber nicht das Originalbild gedreht, sondern es wird ein zweidimensionales Array erstellt, in dem die einzelnen Punkte des Original-Schwarzweißarrays an die richtige Stelle “transformiert“ wurden.

Das Auswerten selbst ist auch nicht gerade trivial. Durchläuft man beispielsweise eine Spalte und es fehlen etwa durch den Scanvorgang einzelne gesetzte Pixel, so kann man das Ergebnis vergessen. Man muss also eine gewisse Unschärfe einbauen und über solch kleine Fehler großzügig hinwegsehen.

Erzeugen von Barcode (Vorschau)

In einem anderen Beispiel wird gezeigt, wie man Barcodebilder vom Typ Code39 oder EAN13 erzeugt, diese als Bilddatei abspeichern oder auch einem Steuerelement als Hintergrund zuweisen kann. Da das Erzeugen und Auswerten irgendwie zusammengehören, sind beide Beispiele in einer Excel Arbeitsmappe zusammengefasst. Beides, das Erzeugen und Decodieren ist aber recht aufwändig und erfordert eine umfangreiche Erklärung. Damit man den Überblick nicht verliert, wird das Erzeugen in einem separaten Dokument beschrieben.

 

Auch bei diesem Beispiel gilt, dass man den Code frei benutzen kann. Eine Veröffentlichung des Codes oder Teilen davon, womöglich noch unter anderem Namen, sollte aber unterbleiben.

Excel-Dateien zum Download ca. 500 KB: Barcode.xlsm oder Barcode.xls

Das Tabellenblatt Barcode Auswerten

EAN13

Abbildung 1: Auswertung EAN13

Code39

Abbildung 2: Auswertung Code39

Die in den beiden Abbildungen verwendeten Barcodebilder wurden übrigens von mir selbst erzeugt, im Tabellenblatt “Barcode Erzeugen“ kann man eigene erstellen.

Auf diesem Tabellenblatt “Barcode Auswerten“ befinden sich links zwei Bildanzeige-Steuerelemente. In dem Steuerelement links oben kann man über den Klick auf die Schaltfläche “Bild Laden“ eine JPG- oder BMP-Datei auswählen und sich anzeigen lassen. Mit der Bildlaufleiste “Rotationswinkel“ wählt man einen Winkel aus, um dem das Bild nach einem Klick auf die Schaltfläche “Rotieren“ nach rechts rotiert und im zweiten Bildanzeige Steuerelement um den eingestellten Winkel gedreht angezeigt wird.

  1. Mit der Bildlaufleiste in Zeile 12 legt man den Schwellwert der Helligkeit fest, ab der ein Pixel als schwarz oder weiß interpretiert wird.
  2. Die Bildlaufleiste in Zeile 13 legt die Schrittweite des Winkels fest, um den das Bild nacheinander gedreht und anschließend ausgewertet wird. Eine große Schrittweite macht das Auswerten schneller, birgt aber auch die Gefahr, dass der zum korrekten Auslesen notwendige Winkel verpasst wird.
  3. Mit Hilfe der Bildlaufleiste in Zeile 14 legt man fest, in welchen Abstand in Pixeln einzelne Spalten des Bildes nach Barcode durchsucht werden. Da das für jedes gedrehte Bild gilt, ist das ein Wert, der die Geschwindigkeit der Auswertung sehr stark beeinflusst. Ein hoher Wert kann aber dafür sorgen, dass der Bereich, in dem sich der Barcode befindet, beim Scannen übersprungen wird.
  4. Die Bildlaufleiste in Zeile 15 legt die Größe der weißen Ruhezone um den Barcode in Pixel fest. Je größer man diesen Wert wählen kann, umso weniger weiße Stellen eines Bildes werden als Ruhezone mit nachfolgendem Barcode interpretiert.
  5. Die Balkenbreite, welche man über die Bildlaufleiste in Zeile 16 angeben kann, beeinflusst das Scanverhalten. Es müssen nebeneinander mindestens 50 % dieses Wertes an schwarzen Pixeln vorhanden sein, damit ein Pixel einer Scanlinie als schwarz interpretiert wird. Das Fehlen einzelner gesetzter Pixel spielt dann keine so große Rolle mehr. Selbstverständlich muss dann auch die Breite, nicht die Dicke eines Balkens entsprechend groß sein.
  6. Mit den Checkboxen in Zeile 17, 18 oder 19 wird zum Einen festgelegt, ob nach EAN 13, nach Code 39 oder beiden gescannt wird und zusätzlich noch, ob der Scanvorgang direkt nach dem ersten Fund abgebrochen wird.
  7. Die Checkbox in Zeile 20 ist beim Auswerten von Code 39 wichtig. Bei Code 39 kann optional eine Prüfzahl benutzt werden, die als letztes Zeichen des Textes codiert ist. Legt man fest, dass die Prüfzahl ausgewertet werden soll, wird das letzte Zeichen des Textes in eine Zahl umgewandelt. Aus dem restlichen Text wird die Prüfzahl errechnet und beide miteinander verglichen. Stimmt die errechnete mit der codierten Zahl überein, wird der Text ohne das Prüfzeichen ausgegeben. Soll die Prüfziffer ignoriert werden, wird ein eventuell vorhandenes Prüfzeichen als normales Zeichen interpretiert und mit ausgegeben.

Das Klassenmodul des Tabellenblatts Barcode

Option Explicit

Private Sub cmdLoad_Click()
   Dim varPic As Variant
   varPic = Application.GetOpenFilename(("Bilder (*.jpg; *.bmp), *.jpg; *.bmp"))
   If varPic = False Then Exit Sub
   Me.OLEObjects("Image1").Object.Picture = LoadPicture(CStr(varPic))
End Sub

Private Sub cmdRotate_Click()
   Dim x          As New clsPicRotate
   Dim objPic     As IPictureDisp
   Dim objDest    As IPictureDisp
   
   Set objPic = Me.OLEObjects("Image1").Object.Picture
   With x
      .Picture = objPic
      .Rotate = Me.Range("J1")
      Set objDest = .GetPicture
   End With
   Me.OLEObjects("Image2").Object.Picture = objDest
   
End Sub
Private Sub cmdParse_Click()
   Dim objBarcode As New clsBarcode
   Dim objPic     As IPictureDisp
   Dim lngWidth   As Long
   Dim lngHeight  As Long
   Dim strCode    As String
   
   Set objPic = Me.OLEObjects("Image2").Object.Picture
   
   With objBarcode
      .Picture = objPic
      .SchwellwertSchwarzWeiß = Me.Range("J12")
      .Winkelschrittweite = Me.Range("J13")
      .SpaltenSchrittweite = Me.Range("J14")
      .RuhezoneInPixel = Me.Range("J15")
      .Balkenbreite = Me.Range("J16")
      .ScanEAN13 = Me.Range("J17")
      .ScanCode39 = Me.Range("J18")
      .ExitOnMatch = Me.Range("J19")
      .Code39CheckNumber = Me.Range("J20")
      strCode = .GetBarcode
      lngWidth = .GrößeX
      lngHeight = .GrößeY
      MsgBox "Code : " & strCode _
         & vbCrLf & _
         "Zeitdauer zum Decodieren : " & Format(.Suchdauer, "nn:ss") _
         & vbCrLf & _
         "Größe Bild x=" & lngWidth & "  y=" & lngHeight, _
         vbInformation, "Code und Zeitdauer"
      
   End With
   
End Sub

Das Klickereignis der Schaltfläche cmdLoad

In dieser Ereignisprozedur wird mit dem GetOpenFilename Dialog der Pfad zu einer Bitmap- oder einer JPG-Datei erfragt. Diese Datei wird mit der LoadPicture-Methode geladen und der Picture-Eigenschaft des linken oberen Bildsteuerelementes zugewiesen.

Das Klickereignis der Schaltfläche cmdRotate

In dieser Ereignisprozedur wird zu Beginn eine Variable vom Typ clsPicRotate angelegt. Dieser Variablen wird über die Eigenschaft Picture das Bild des ersten Bildsteuerelements zugewiesen. Die Rotate-Eigenschaft nimmt den Winkel auf, um den das Bild nach rechts gedreht wird, die GetPicture-Methode liefert das rotierte Bild. Das rotierte Bild wird über die Picture-Eigenschaft dem linken unteren Bildsteuerelementes zugewiesen, welches anschließend das gedrehte Bild anzeigt.

Das Klickereignis der Schaltfläche cmdParse

In dieser Ereignisprozedur wird zu Beginn ein Objekt vom Typ clsBarcode erzeugt. Diesem Objekt werden über Eigenschaften verschiedene Werte übergeben, die zuvor aus dem Tabellenblatt ausgelesen wurden. Die wichtigste Eigenschaft ist dabei die Picture-Eigenschaft, der man das Picture-Objekt des linken unteren Bildsteuerelements zuweist. Die GetBarcode-Methode startet den Scanvorgang und liefert die dekodierte Ziffer- oder Zeichenfolge. Zusammen mit der benötigten Zeit und der ausgewerteten Bildgröße wird das Ergebnis anschließend in einer Meldungsbox ausgegeben.

Das Klassenmodul clsPicRotate

Dieses Klassenmodul wurde bereits im Beispiel Rotation behandelt und wird hier nicht weiter erklärt.

Das Klassenmodul clsBarcode

Option Explicit
Private Declare Function GetObject _
   Lib "gdi32" Alias "GetObjectA" ( _
   ByVal hObject As Long, _
   ByVal nCount As Long, _
   lpObject As Any _
   ) As Long
Private Declare Sub CopyMemory _
   Lib "kernel32" Alias "RtlMoveMemory" ( _
   pDst As Any, _
   pSrc As Any, _
   ByVal ByteLen As Long)
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private mobjPicture     As IPictureDisp
Private mbyteBW         As Byte
Private mbyteWidth      As Byte
Private mblnMatch       As Boolean

Private mstrCodeA       As String
Private mstrCodeB       As String
Private mstrCodeC       As String
Private mstrCodeMeta    As String
Private mstrCode39a     As String
Private mstrCode39b     As String

Private mcolResult      As Collection
Private mblnExitOnMatch As Boolean
Private mblnEAN13       As Boolean
Private mblnCode39      As Boolean

Private mvarPicArr      As Variant
Private mlngPicArr1()   As Long
Private mvarPicRot      As Variant
Private mlngStepDegree  As Long
Private mdteSearchTime  As Date
Private mdteBegin       As Date
Private mlngPXWhiteZone As Long
Private mlngStepCol     As Long
Private mstrCheckChar   As String
Private mblnCode39Check As Boolean
Private mlngResX        As Long
Private mlngResY        As Long

Public Function GetBarcode() As String
   Dim x             As Long
   Dim y             As Long
   Dim i             As Long
   Dim k             As Long
   Dim lngActCol       As Long
   Dim lngActX       As Long
   Dim lngMaxX       As Long
   Dim lngMaxY       As Long
   Dim lngCount      As Long
   Dim strCol        As String
   Dim adblDegree()  As Double
   Dim varDummy      As Variant
   Dim strDummy      As String
   Dim objPicture    As IPictureDisp
   
   If Not (mblnEAN13 Or mblnCode39) Then
      GetBarcode = "Keine Scanmethode gewählt"
      Exit Function
   End If
   
   If mobjPicture Is Nothing Then
      MsgBox "Kein gültiges Bild!"
      Exit Function
   End If
   
   mdteSearchTime = 0
   mdteBegin = Now
   
   Set mcolResult = New Collection
   
   
   ' Zu scannende Winkel im Array ablegen, damit man
   ' bevorzugte Winkel an den Beginn legen kann
   ReDim adblDegree(1 To 200)
   adblDegree(1) = 0
   adblDegree(2) = mlngStepDegree
   adblDegree(3) = 2 * mlngStepDegree
   adblDegree(4) = 90
   adblDegree(5) = 90 - mlngStepDegree
   adblDegree(6) = 90 - 2 * mlngStepDegree
   adblDegree(7) = 90 + mlngStepDegree
   adblDegree(8) = 90 + 2 * mlngStepDegree
   adblDegree(9) = 180 - mlngStepDegree
   adblDegree(10) = 180 - 2 * mlngStepDegree
   
   i = 10
   For k = 3 * mlngStepDegree To _
      90 - 2 * mlngStepDegree Step mlngStepDegree
      i = i + 1
      adblDegree(i) = k
   Next
   
   For k = 90 + 3 * mlngStepDegree To _
      180 - 2 * mlngStepDegree Step mlngStepDegree
      i = i + 1
      adblDegree(i) = k
   Next
   
   ReDim Preserve adblDegree(1 To i)
   
   ' Marker "Gefunden" zurücksetzen
   mblnMatch = False
   
   ' Bild in ein Schwarzweißarray kopieren
   mvarPicArr = BlackWhite(mobjPicture)
   
   For k = 1 To UBound(adblDegree)
   
      ' Bild (Array) drehen
      RotateTo adblDegree(k)
      
      ' Größe des gedrehten Arrays ermitteln
      lngMaxX = UBound(mvarPicRot, 1)
      lngMaxY = UBound(mvarPicRot, 2)
      
      ' Jede festgelegte Spalte durchlaufen
      For x = 0 To lngMaxX Step mlngStepCol
      
         ' Von der Mitte ausgehend erst die Spalten
         ' nach links, dann nach rechts bis zum Ende
         lngActCol = lngMaxX / 2 - x
         If lngActCol <= 0 Then lngActCol = x
         
         ' Diese Variable nimmt das Ergebnis
         ' einer Spalte auf
         strCol = ""
   
         ' Jeden Punkt der Spalte durchlaufen
         For y = 0 To lngMaxY
         
            lngCount = 0
            
            ' Endpunkt auf X-Achse berechnen
            i = lngActCol + mbyteWidth
            If i > lngMaxX Then i = lngMaxX
            
            ' Die Punkte auf X-Achse ab aktueller Spalte bis
            ' Endpunkt durchlaufen, die gesetzten zählen
            For lngActX = lngActCol To i
               If mvarPicRot(lngActX, y) Then lngCount = lngCount + 1
            Next lngActX
            
            If lngCount >= (mbyteWidth * 0.5) Then
               ' Schwarz
               strCol = strCol & "B"
            Else
               ' Weiß
               strCol = strCol & "W"
            End If
            
         Next y
         
         ParseColumn strCol
         
      Next x
      
      
      If mblnExitOnMatch And mblnMatch Then
        ' Beenden, wenn etwas gefunden wurde
        Exit For
      End If
      
   Next k
   
   For Each varDummy In mcolResult
      ' Alle Ergebnisse durchlaufen
      GetBarcode = GetBarcode & varDummy & vbCrLf
   Next
   
   If GetBarcode = "" Then
      GetBarcode = "Kein Fund"
   Else
      GetBarcode = Left(GetBarcode, Len(GetBarcode) - 2)
   End If
   
   mdteSearchTime = Now - mdteBegin
   
End Function

Private Sub ParseColumn(ByVal strCol As String)
   Dim k          As Long
   Dim m          As Long
   Dim o          As Long
   Dim strDummy   As String
   
   On Error Resume Next
   
   Do
   
      ' Ruhezone suchen
      m = InStr(1, strCol, String(mlngPXWhiteZone, "W") & "BB")
      
      ' Keine beginnende Ruhezone gefunden
      If m = 0 Then Exit Do
      
      ' Alles bis Ende erste Ruhezone rausschmeißen
      strCol = Mid(strCol, m + mlngPXWhiteZone)

      ' Dekodieren
      strDummy = Decode39(strCol)
      
      If strDummy <> "" Then
      
         ' gefundene Werte in Collection eintragen
         mcolResult.Add strDummy, "X" & strDummy
         mblnMatch = True
         
      End If
      
      ' Dekodieren
      strDummy = DecodeEAN13(strCol)
      
      If strDummy <> "" Then
      
         ' gefundene Werte in Collection eintragen
         mcolResult.Add strDummy, "X" & strDummy
         mblnMatch = True
         
      End If

   Loop

End Sub

Private Function Decode39(ByVal strCode As StringAs String
   Dim i                      As Long
   Dim k                      As Long
   Dim m                      As Long
   Dim x                      As Long
   Dim blnEndTag              As Boolean
   Dim lngModuleLen           As Long
   Dim strResult              As String
   Dim strDummy               As String
   Dim strInverse             As String
   Dim strCode1               As String
   Dim dblDummy               As Double
   Dim varDummy               As Variant
   Dim lngEnd                 As Long
   
   If strCode = "" Then Exit Function
   If Not mblnCode39 Then Exit Function
   
   i = 1
   m = Len(strCode)
   
   ' Dicke der 1. dünnen Linie ermitteln
   lngModuleLen = InStr(i, strCode, "BWW")
   
   Do While i < m
      ' In einzelne Striche und Lücken aufteilen
      ' Dabei werden gewisse Toleranzen ausgeglichen
      
      strDummy = Mid(strCode, i, 1)
      
      If strDummy = "B" Then
         ' Schwarzes Modul, endet vor "WW"
         k = InStr(i, strCode, "WW")
         x = x + 1
      Else
         ' Weißes Modul, endet vor "BB"
         k = InStr(i, strCode, "BB")
      End If
      
      If k = 0 Then Exit Do
      
      ' Breite berechnen
      dblDummy = k - i
      
      ' Beginn nächstes Modul
      i = k
      
      If (dblDummy / CDbl(lngModuleLen)) < 1.8 Then
         ' Breite kleiner als 1,8 mal dünne Linie
         ' Logische Null
         strCode1 = strCode1 & "0"
      Else
         ' Breite größer gleich 1,8 mal dünne Linie
         ' Logische Eins
         strCode1 = strCode1 & "1"
      End If
      
      If (x Mod 5) = 0 Then
         ' 5 schwarze Module mit 4 eingeschlossenen weißen Modulen
         
         ' Lücke überspringen
         i = InStr(i, strCode, "WBB")
         
         ' Kein nächstes Zeichen, beenden
         If i = 0 Then Exit Do
         
         ' Beginn nächstes Zeichen
         i = i + 1
         
         ' Trennzeichen hinzufügen
         strCode1 = strCode1 & "-"
         
      End If
      
   Loop
   
   If Left(strCode1, 9) = "001010010" Then
      ' Leserichtung verkehrt

      For i = 1 To Len(strCode1)
         ' Den String invertieren
         strInverse = Mid(strCode1, i, 1) & strInverse
      Next
      
      strCode1 = strInverse
      
      If InStr(1, strCode1, "010010100-") = 0 Then
         Exit Function
      Else
         strCode1 = Mid(strCode1, InStr(1, strCode1, "010010100-"))
      End If

   End If
   
   If Left(strCode1, 9) <> "010010100" Then Exit Function
   
   If InStr(1, strCode1, "-010010100") = 0 Then Exit Function
   
   varDummy = Split(strCode1, "-")
   
   If Not (IsArray(varDummy)) Then Exit Function
  
   ' Alle Module (Zeichen) durchlaufen
   For m = 1 To UBound(varDummy)
   
      If Len(varDummy(m)) = 9 Then
      ' Länge des Moduls ist 9 (Bits)
      
         ' Code in Codetabelle (als String) suchen
         i = InStr(1, mstrCode39b, varDummy(m))
         
         If i <> 0 Then
         ' Code in Codetabelle gefunden
         
            i = (i - 1) / 10
            
            ' Zeichen aus Codetabelle holen
            strResult = strResult & Mid(mstrCode39a, i + 1, 1)
               
            
         End If
         
      End If
      
   Next
   
   If Right(strResult, 1) = "*" Then
      strResult = Replace(strResult, "*", "")
      If mblnCode39Check Then
         ' Überprüfen, ob Prüfzeichen passt
         If  Code39CheckChar(strResult) Then
            ' Prüfzeichen rausschmeißen
            Decode39 = Left(strResult, Len(strResult) - 1)
         End If
      Else
         ' Alles ohne Anfangs-Endezeichen zurückgeben
         Decode39 = strResult
      End If
   End If
   
End Function

Private Function Code39CheckChar(strCode39 As StringAs Boolean
   Dim i          As Long
   Dim k          As Long
   Dim m          As Long
   Dim strChar    As String
   
   m = 0
   
   For i = 1 To Len(strCode39) - 1
   
      ' Zeichen extrahieren
      strChar = Mid(strCode39, i, 1)
      
      ' Code in Codetabelle (als String) suchen
      k = InStr(1, mstrCode39a, strChar) - 1
      
      If k > -1 Then
      ' Code in Codetabelle gefunden
      
         m = m + k
      End If
      
   Next
   
   ' Der Divisionsrest durch 43 wird ermittelt,
   ' das Zeichen extrahiert und verglichen
   Code39CheckChar = Mid(mstrCode39a, (m Mod 43) + 1, 1) = _
      Right(strCode39, 1))
End Function

Private Function DecodeEAN13(ByVal strCode As StringAs String
   Dim i                      As Long
   Dim k                      As Long
   Dim m                      As Long
   Dim dblModuleLen           As Long
   Dim lngModuleLen           As Long
   Dim strLeft                As String
   Dim strRight               As String
   Dim strResult              As String
   Dim strDummy               As String
   Dim strCode1               As String
   Dim strCodeTablesLeft      As String
   Dim lngCheck               As Long
   Dim dblDummy               As Long
   
   If strCode = "" Then Exit Function
   If Not mblnEAN13 Then Exit Function
   
   ' durchschnittliche Modullänge ermitteln
   dblModuleLen = InStr(1, strCode, "WBB")
   dblModuleLen = InStr(dblModuleLen, strCode, "BWW") + 1
   
   lngModuleLen = Int(dblModuleLen / 3)
   
   If (lngModuleLen = 0) Or (lngModuleLen > 15) Then Exit Function
   
   i = 1
   
   Do
      ' In 95 einzelne Module aufteilen, pro Modul ein Buchstabe.
      
' Dabei werden gewisse Toleranzen ausgeglichen
      
      ' Buchstabe Beginn Modul auslesen
      strDummy = Mid(strCode, i, 1)
      
      If strDummy = "B" Then
         ' Schwarzes Modul, endet vor "WW"
         k = InStr(i, strCode, "WW")
      Else
         ' Weißes Modul, endet vor "BB"
         k = InStr(i, strCode, "BB")
      End If
      
      If k = 0 Then Exit Do
      
      ' Modulbreite in Pixel berechnen
      dblDummy = k - i
      
      ' Wenn die Modulbreite zu groß ist, beenden
      If dblDummy > (4 * lngModuleLen) Then Exit Do
      
      ' Beginn nächstes Modul
      i = k
      
      ' Modulbreite als Ganzzahl
      k = Int((dblDummy / CDbl(lngModuleLen)) + 0.45)
      
      ' Anzahl Zeichen B oder W an den String strCode1 anhängen
      If strDummy = "B" Then
         strCode1 = strCode1 & String(k, "B")
      Else
         strCode1 = strCode1 & String(k, "W")
      End If
      
   Loop
   
   ' 95 Module sind erforderlich
   ' (12 Ziffern*7 + 2 Randzeichen*3 + 1 Mittelzeichen*5)
   ' Verlassen, wenn weniger als 95 Module
   If Len(strCode1) < 95 Then Exit Function
   
   ' Exakt 95 Module rausschneiden
   strCode = Left(strCode1, 95)
   
   ' Abbrechen, wenn linkes oder rechtes Randzeichen fehlt
   If Left(strCode, 3) <> "BWB" Then Exit Function
   If Right(strCode, 3) <> "BWB" Then Exit Function
   
   ' Linke und rechte Hälfte extrahieren
   strLeft = Mid(strCode, 3 + 1, 42)
   strRight = Mid(strCode, 50 + 1, 42)
   
   ' Ziffer 2 gehört immer zum Zeichensatz A, wird andersherum
   ' gelesen, ist das die gespiegelte Prüfziffer. Die Prüfziffer
   ' ist immer im Zeichensatz C, der gespiegelte Zeichensatz C
   ' ist immer B. Also muss die gespiegelte Prüfziffer im
   ' Zeichensatz B zu Finden sein.
   
If InStr(1, mstrCodeB, Mid(strLeft, 1, 7)) > 0 Then
   
      ' Reihenfolge Striche/Lücken links tauschen
      strDummy = ""
      For i = 1 To Len(strLeft)
         strDummy = Mid(strLeft, i, 1) & strDummy
      Next
      strLeft = strDummy
      
      ' Reihenfolge Striche/Lücken rechts tauschen
      For i = 1 To Len(strRight)
         strDummy = Mid(strRight, i, 1) & strDummy
      Next
      strRight = strDummy
      
      ' Links-rechts tauschen
      strDummy = strLeft
      strLeft = strRight
      strRight = strDummy
      
   End If
   
   ' Ziffern Linke Hälfte durchlaufen
   For m = 1 To 42 Step 7
   
      ' Ziffer extrahieren
      strDummy = Mid(strLeft, m, 7)
      
      ' Überprüfen, welche Ziffer zu der Folge passt
      i = InStr(1, mstrCodeA, strDummy)
      If i > 0 Then
         strResult = strResult & Int(i / 8)
         ' Ziffer in Zeichensatz A
         strCodeTablesLeft = strCodeTablesLeft & "A"
      Else
         i = InStr(1, mstrCodeB, strDummy)
         If i > 0 Then
            strResult = strResult & Int(i / 8)
            ' Ziffer in Zeichensatz B
            strCodeTablesLeft = strCodeTablesLeft & "B"
         Else
            Exit Function
         End If
      End If
      
   Next m
   
   ' Zeichensatzfolge der linken Hälfte codiert
   ' die vorangestellte Ziffer (Metacode)
   i = InStr(1, mstrCodeMeta, strCodeTablesLeft)
   If i > 0 Then
      strResult = Int(i / 7) & strResult
   Else
      Exit Function
   End If
   
   ' Ziffern Rechte Hälfte und Prüfziffer durchlaufen
   For m = 1 To 42 Step 7
   
      ' Ziffer extrahieren
      strDummy = Mid(strRight, m, 7)
      
      ' Überprüfen, welche Ziffer zu der Folge passt
      i = InStr(1, mstrCodeC, strDummy)
      If i > 0 Then
         strResult = strResult & Int(i / 8)
      Else
         Exit Function
      End If
      
   Next m
   
   ' Weniger als 13 Zahlen, dann verlassen
   If Len(strResult) < 13 Then Exit Function
   
   ' Prüfziffer berechnen
   For i = 1 To 12
      If (i Mod 2) = 1 Then
         ' Ungerade werden einfach gewertet
         lngCheck = lngCheck + CLng(Mid(strResult, i, 1))
      Else
         ' Gerade werden dreifach gewertet
         lngCheck = lngCheck + CLng(Mid(strResult, i, 1)) * 3
      End If
   Next
   
   ' Der Divisionsrest durch 10 wird ermittelt
   lngCheck = 10 - lngCheck Mod 10
   If lngCheck = 10 Then lngCheck = 0
   
   If CLng(Right(strResult, 1)) = lngCheck Then
      ' Wenn Prüfziffer mit Berechneter übereinstimmt,
      ' Ergebnis zurückgeben
      DecodeEAN13 = strResult
   End If
   
End Function

Private Sub RotateTo(ByVal myDegree As Double)
   Dim x                As Long
   Dim y                As Long
   Dim maxX             As Long
   Dim maxY             As Long
   Dim lngHeight        As Long
   Dim lngWidth         As Long
   Dim ablnRot()        As Boolean
   Dim lngDestX         As Long
   Dim lngDestY         As Long
   Dim lngMidXDest      As Long
   Dim lngMidYDest      As Long
   Dim lngSourceX       As Long
   Dim lngSourceY       As Long
   Dim lngMidXSource    As Long
   Dim lngMidYSource    As Long
   
   On Error Resume Next
   
   ' Aktuellen Winkel im Bogenmaß berechnen
   myDegree = -1 * myDegree * 3.141592 / 180
   
   ' Größe Quellarray auslesen
   maxX = mvarPicArr(1, 0)
   maxY = mvarPicArr(2, 0)
   
   ' Mittelpunkt Quelle berechnen
   lngMidXSource = maxX / 2
   lngMidYSource = maxY / 2
   
   ' Größe des benötigten Zielarrays ermitteln
   lngHeight = Abs(Cos(myDegree)) * (maxY + 1) + Abs(Sin(myDegree)) * (maxX + 1)
   lngWidth = Abs(Cos(myDegree)) * (maxX + 1) + Abs(Sin(myDegree)) * (maxY + 1)
   
   ' Zielarray dimensionieren
   ReDim ablnRot(lngWidth, lngHeight)
   
   ' Mittelpunkt Ziel berechnen
   lngMidXDest = lngWidth / 2
   lngMidYDest = lngHeight / 2
   
   
   For x = 1 To UBound(mvarPicArr, 2)
   ' Alle schwarzen Pixel durchlaufen
   
      ' Position vom Mittelpunkt berechnen
      lngSourceX = mvarPicArr(1, x) - lngMidXSource
      lngSourceY = mvarPicArr(2, x) - lngMidYSource
      
      ' Position im Zielarray berechnen
      lngDestX = lngMidXDest + _
         lngSourceX * Cos(myDegree) + _
         lngSourceY * Sin(myDegree)
      lngDestY = lngMidYDest - _
         lngSourceX * Sin(myDegree) + _
         lngSourceY * Cos(myDegree)
      
      ' Wert im Zielarray setzen
      ablnRot(lngDestX, lngDestY) = True
            
   Next
   
   mvarPicRot = ablnRot
   
End Sub

Private Function BlackWhite(objPicture As StdPicture) As Variant
   Dim udtBMP           As BITMAP
   Dim abytPixel()      As Byte
   Dim abytBW()         As Boolean
   Dim x                As Long
   Dim y                As Long
   Dim i                As Long
   Dim lngXMax          As Long
   Dim lngYMax          As Long
   Dim lngBytPix        As Long
   Dim alngPicArr1()    As Long
   
   On Error Resume Next
   
   ' Bitmapstruktur des Bildes ausfüllen lassen
   GetObject objPicture.handle, Len(udtBMP), udtBMP

   With udtBMP
   
      If .bmBitsPixel < 24 Then
         MsgBox "Farbtiefe beträgt " & .bmBitsPixel & " Bits!" _
            & vbCrLf & "Gefordert sind aber min. 24 Bits."
         Exit Function
      End If
      
      ' Anzahl der Bytes pro Pixel
      lngBytPix = .bmBitsPixel / 8
   
      ' Array dimensionieren, welches die Bitmapdaten aufnimmt
      ReDim abytPixel(0 To .bmWidthBytes - 1, 0 To .bmHeight - 1)
      
      ' Abmessungen Array STDPICTURE auslesen
      lngXMax = UBound(abytPixel, 1)
      lngYMax = UBound(abytPixel, 2)
      
      ' Bitmapinhalt ins Array kopieren
      CopyMemory abytPixel(0, 0), ByVal .bmBits, _
         .bmHeight * .bmWidthBytes
         
      ' Array mit Position der Schwarzwerte dimensionieren
      ReDim alngPicArr1(1 To 2, .bmHeight * .bmWidth)
      
      ' Abmessungen Original merken
      alngPicArr1(1, 0) = .bmWidth
      alngPicArr1(2, 0) = .bmHeight
      
      mlngResX = .bmWidth
      mlngResY = .bmHeight

   End With

   
   For y = lngYMax To 0 Step -1
   ' Alle Reihen des Arrays durchlaufen.
Unten Links im Array
   ' ist Pixel 1 der ersten Reihe
   
      For x = 0 To lngXMax Step lngBytPix
      ' Spalten durchlaufen. Je drei Elemente des Arrays in der
      ' zweiten Dimension beschreiben ein Pixel. Das erste ist der
      ' Blau-, das zweite der Grün- und das dritte der Rotwert.
      
         
If (abytPixel(x, y) * 0.11 + _
            abytPixel(x + 1, y) * 0.59 + _
             abytPixel(x + 2, y) * 0.3) < mbyteBW Then
             
            ' Schwarz (Vordergrundfarbe), Position merken
            i = i + 1
            alngPicArr1(1, i) = x / lngBytPix
            alngPicArr1(2, i) = lngYMax - y
         End If
         
      Next x ' Nächste Spalte
      
   Next y ' Nächste Zeile
   
   ' Array zurechtstutzen
   ReDim Preserve alngPicArr1(1 To 2, i)
   
   ' Array mit Daten zurückgeben
   BlackWhite = alngPicArr1
   
End Function


Private Sub Class_Initialize()
   ' Schrittweite der Abtastung von Spalten in Pixel
   mlngStepCol = 10
   
   ' Breite Ruhezone in Pixel
   mlngPXWhiteZone = 10
   
   ' Helligkeitsgrenze Schwarz/Weiß
   mbyteBW = 125
   
   ' Balkenbreite
   mbyteWidth = 10
   
   ' Verlassen, wenn bei einem Winkel etwas gefunden wurde
   mblnExitOnMatch = True
   
   ' Schrittweite Winkel
   mlngStepDegree = 5
   
   ' Scan EAN13
   mblnEAN13 = True
   
   ' Scan Code39
   mblnCode39 = True
   
   ' EAN-Codetabelle erstellen
   InitEAN
   
   ' Code 39-Codetabelle erstellen
   InitCode39
   
End Sub

Public Property Let SpaltenSchrittweite(ByVal vNewValue As Byte)
   mlngStepCol = vNewValue
   If mlngStepCol < 1 Then mlngStepCol = 1
End Property
Public Property Let SchwellwertSchwarzWeiß(ByVal vNewValue As Byte)
   mbyteBW = vNewValue
End Property
Public Property Let Balkenbreite(ByVal vNewValue As Byte)
   mbyteWidth = vNewValue
   If mbyteWidth < 2 Then mbyteWidth = 2
End Property
Public Property Let Picture(ByVal vNewValue As IPictureDisp)
   Set mobjPicture = vNewValue
End Property
Public Property Let ExitOnMatch(ByVal vNewValue As Boolean)
   mblnExitOnMatch = vNewValue
End Property
Public Property Let ScanEAN13(ByVal vNewValue As Boolean)
   mblnEAN13 = vNewValue
End Property
Public Property Let ScanCode39(ByVal vNewValue As Boolean)
   mblnCode39 = vNewValue
End Property
Public Property Let Code39CheckNumber(ByVal vNewValue As Boolean)
   mblnCode39Check = vNewValue
End Property
Public Property Let RuhezoneInPixel(ByVal vNewValue As Long)
   mlngPXWhiteZone = vNewValue
   If mlngPXWhiteZone < 5 Then mlngPXWhiteZone = 5
End Property
Public Property Let Winkelschrittweite(ByVal vNewValue As Long)
   mlngStepDegree = vNewValue
   If mlngStepDegree < 1 Then mlngStepDegree = 1
End Property
Public Property Get Suchdauer() As Date
   Suchdauer = mdteSearchTime
End Property
Public Property Get GrößeX() As Long
   GrößeX = mlngResX
End Property
Public Property Get GrößeY() As Long
   GrößeY = mlngResY
End Property

Private Sub InitCode39()
   Dim astr39(43, 1 To 2)  As String
   Dim i                   As Long
   astr39(1, 1) = "1": astr39(1, 2) = "100100001"
   astr39(2, 1) = "2": astr39(2, 2) = "001100001"
   astr39(3, 1) = "3": astr39(3, 2) = "101100000"
   astr39(4, 1) = "4": astr39(4, 2) = "000110001"
   astr39(5, 1) = "5": astr39(5, 2) = "100110000"
   astr39(6, 1) = "6": astr39(6, 2) = "001110000"
   astr39(7, 1) = "7": astr39(7, 2) = "000100101"
   astr39(8, 1) = "8": astr39(8, 2) = "100100100"
   astr39(9, 1) = "9": astr39(9, 2) = "001100100"
   astr39(0, 1) = "0": astr39(0, 2) = "000110100"
   astr39(10, 1) = "A": astr39(10, 2) = "100001001"
   astr39(11, 1) = "B": astr39(11, 2) = "001001001"
   astr39(12, 1) = "C": astr39(12, 2) = "101001000"
   astr39(13, 1) = "D": astr39(13, 2) = "000011001"
   astr39(14, 1) = "E": astr39(14, 2) = "100011000"
   astr39(15, 1) = "F": astr39(15, 2) = "001011000"
   astr39(16, 1) = "G": astr39(16, 2) = "000001101"
   astr39(17, 1) = "H": astr39(17, 2) = "100001100"
   astr39(18, 1) = "I": astr39(18, 2) = "001001100"
   astr39(19, 1) = "J": astr39(19, 2) = "000011100"
   astr39(20, 1) = "K": astr39(20, 2) = "100000011"
   astr39(21, 1) = "L": astr39(21, 2) = "001000011"
   astr39(22, 1) = "M": astr39(22, 2) = "101000010"
   astr39(23, 1) = "N": astr39(23, 2) = "000010011"
   astr39(24, 1) = "O": astr39(24, 2) = "100010010"
   astr39(25, 1) = "P": astr39(25, 2) = "001010010"
   astr39(26, 1) = "Q": astr39(26, 2) = "000000111"
   astr39(27, 1) = "R": astr39(27, 2) = "100000110"
   astr39(28, 1) = "S": astr39(28, 2) = "001000110"
   astr39(29, 1) = "T": astr39(29, 2) = "000010110"
   astr39(30, 1) = "U": astr39(30, 2) = "110000001"
   astr39(31, 1) = "V": astr39(31, 2) = "011000001"
   astr39(32, 1) = "W": astr39(32, 2) = "111000000"
   astr39(33, 1) = "X": astr39(33, 2) = "010010001"
   astr39(34, 1) = "Y": astr39(34, 2) = "110010000"
   astr39(35, 1) = "Z": astr39(35, 2) = "011010000"
   astr39(36, 1) = "-": astr39(36, 2) = "010000101"
   astr39(37, 1) = ".": astr39(37, 2) = "110000100"
   astr39(38, 1) = " ": astr39(38, 2) = "011000100"
   astr39(39, 1) = "$": astr39(39, 2) = "010101000"
   astr39(40, 1) = "/": astr39(40, 2) = "110100010"
   astr39(41, 1) = "+": astr39(41, 2) = "010001010"
   astr39(42, 1) = "%": astr39(42, 2) = "000101010"
   
   ' Anfangs- Endezeichen
   astr39(43, 1) = "*": astr39(43, 2) = "010010100"
   
   For i = 0 To 43
      ' Einen String erzeugen, der alle Zeichen
      ' ohne Trennzeichen enthält
      mstrCode39a = mstrCode39a & astr39(i, 1)
      ' Einen String erzeugen, der alle Zeichen als
      ' Code mit einem Trennzeichen enthält
      mstrCode39b = mstrCode39b & astr39(i, 2) & " "
   Next
End Sub

Private Sub InitEAN()
   Dim i                  As Long
   Dim astrCode(9, 3)     As String
   
   astrCode(0, 1) = "WWWBBWB" ' Code A
   astrCode(0, 3) = "BBBWWBW" ' Code B
   astrCode(0, 2) = "WBWWBBB" ' Code C
   
   astrCode(1, 1) = "WWBBWWB"
   astrCode(1, 3) = "BBWWBBW"
   astrCode(1, 2) = "WBBWWBB"
      
   astrCode(2, 1) = "WWBWWBB"
   astrCode(2, 3) = "BBWBBWW"
   astrCode(2, 2) = "WWBBWBB"
   
   astrCode(3, 1) = "WBBBBWB"
   astrCode(3, 3) = "BWWWWBW"
   astrCode(3, 2) = "WBWWWWB"
   
   astrCode(4, 1) = "WBWWWBB"
   astrCode(4, 3) = "BWBBBWW"
   astrCode(4, 2) = "WWBBBWB"
      
   astrCode(5, 1) = "WBBWWWB"
   astrCode(5, 3) = "BWWBBBW"
   astrCode(5, 2) = "WBBBWWB"
   
   astrCode(6, 1) = "WBWBBBB"
   astrCode(6, 3) = "BWBWWWW"
   astrCode(6, 2) = "WWWWBWB"
   
   astrCode(7, 1) = "WBBBWBB"
   astrCode(7, 3) = "BWWWBWW"
   astrCode(7, 2) = "WWBWWWB"
   
   astrCode(8, 1) = "WBBWBBB"
   astrCode(8, 3) = "BWWBWWW"
   astrCode(8, 2) = "WWWBWWB"
      
   astrCode(9, 1) = "WWWBWBB"
   astrCode(9, 3) = "BBBWBWW"
   astrCode(9, 2) = "WWBWBBB"
   
   ' Metacode, Zugehörigkeit zu Code A oder B
   astrCode(0, 0) = "AAAAAA"
   astrCode(1, 0) = "AABABB"
   astrCode(2, 0) = "AABBAB"
   astrCode(3, 0) = "AABBBA"
   astrCode(4, 0) = "ABAABB"
   astrCode(5, 0) = "ABBAAB"
   astrCode(6, 0) = "ABBBAA"
   astrCode(7, 0) = "ABABAB"
   astrCode(8, 0) = "ABABBA"
   astrCode(9, 0) = "ABBABA"
   
   For i = 0 To 9
      ' Strings erzeugen, die alle Zeichen als
      ' Code mit einem Trennzeichen enthalten
      mstrCodeMeta = mstrCodeMeta & astrCode(i, 0) & " "
      mstrCodeA = mstrCodeA & astrCode(i, 1) & " "
      mstrCodeB = mstrCodeB & astrCode(i, 2) & " "
      mstrCodeC = mstrCodeC & astrCode(i, 3) & " "
   Next
End Sub

Die Eigenschaftsprozeduren SpaltenSchrittweite, SchwellwertSchwarzWeiß, Balkenbreite, Picture, ExitOnMatch, ScanEAN13, ScanCode39, RuhezoneInPixel, Winkelschrittweite, Suchdauer

Die Eigenschaftsprozeduren nehmen Werte entgegen und speichern diese in Klassenweit gültigen Variablen. Die Eigenschaft Suchdauer gibt die Dauer des Auswertens zurück.

Die Eigenschaftsprozeduren GrößeX und GrößeY

Diese Eigenschaften liefern die Originalgröße des auszuwertenden Bildes.

Die Initialisierungsprozedur Class_Initialize

Diese Prozedur wird beim Erzeugen der Klasse abgearbeitet und belegt einige Klassenweit gültige Variablen mit frei wählbaren Standardwerten. Das ist wichtig, da das Setzen der meisten Klasseneigenschaften von außen optional ist.

Die Prozedur InitCode39

Diese Prozedur erzeugt zwei Zeichenketten, die eine enthält alle 43 möglichen Zeichen des Code39 als Strichcodefolge mit Trennzeichen zwischen den Strichcodefolgen, die andere nimmt die entsprechenden Zeichen im Klartext auf.

Ein schmaler Strich oder Lücke gilt dabei als 0, ein breiter Strich oder Lücke wird als 1 gewertet. Fünf Striche und die vier Lücken dazwischen repräsentieren ein Zeichen. Zwischen den einzelnen Zeichen im Barcode befindet sich immer eine Lücke. Am Anfang und am Ende eines Barcodes steht immer ein bestimmtes Zeichen, codiert als "010010100", dieses markiert somit den Anfang und das Ende.

Die Prozedur InitEAN

Diese Prozedur erzeugt eine Zeichenkette, welche alle möglichen Ziffern als Folge von sieben schwarzen oder weißen Modulen enthält. Schwarz wird als ein großes “B“ dargestellt, der Hintergrund als ein großes “W“. In die Zeichenkette werden Trennzeichen zwischen den Codefolgen eingebaut. Ein Zeichen besteht aus zwei Balken und zwei Lücken, die sich, wie bereits erwähnt, aus insgesamt sieben Modulen zusammensetzen. Die Zeichenfolge "WBWWBBB" stellt also eine weiße Lücke, bestehend aus einem Modul, einem schwarzen Balken mit einem Modul, eine weiße Lücke aus zwei Modulen und schließlich einem schwarzen Balken aus 3 Modulen dar.

Es gibt beim EAN-Code vier verschiedene Zeichensätze, die Zeichensätze A, B, C und der Meta-Zeichensatz. Die Grundlage ist dabei eine Folge schwarzer oder weißer Module des Zeichensatzes A. Der Zeichensatz B ist die gespiegelte Modulfolge A, wobei auch noch die einzelnen Module invertiert sind. Der Zeichensatz C ist der gespiegelte Zeichensatz B. Der Metazeichensatz wird aus der Folge der Zeichensätze der linken Hälfte (A und B) des Barcodes gebildet. In der linken Hälfte befinden sich ausschließlich Zeichen der Zeichensätze A und B, in der rechten Hälfte ausschließlich Zeichen des Zeichensatzes C.

Der Barcode beginnt und endet immer mit einem Randzeichen, welches aus drei Modulen (BWB) besteht und enthält ein Trennzeichen in der Mitte aus fünf Modulen (WBWBW). Die linke Hälfte beinhaltet die Ziffern 2 bis 7, die rechte Hälfte die Ziffern 8 bis 13, wobei die 13. Ziffer eine Prüfziffer ist. Das 1. Zeichen, das links vom Randzeichen stehende, wird aus der Folge der Zeichensätze der linken Hälfte codiert, besitzt also im eigentlichen Sinn gar keine Folge aus Strichen und Lücken.

Die Prüfziffer wird so berechnet, dass die Ziffern 1-12 addiert werden, wobei die Ziffern an einer geraden Position zuvor mit 3 multipliziert werden. Bei einer Division der Summe durch Zehn bleibt ein Rest, der von 10 abgezogen die Prüfziffer ergibt.

Die Funktion BlackWhite

Diese Funktion übernimmt als Argument ein Bild vom Typ StdPicture, bzw. IPictureDisp. Als Funktionsergebnis wird ein zweidimensionales Array mit den Positionen aller schwarzen Pixel zurückgegeben.

Mit Hilfe der API-Funktion GetObject (nicht zu verwechseln mit der VBA-Funktion GetObject) wird eine Struktur vom Typ BITMAP ausgefüllt, welche anschließend allgemeine Informationen über das Bild und ein Handle (Zeiger) auf die Bitmap enthält. Nun legt man ein zweidimensionales Bytearray an, welches alle Pixel des Originalbildes mit allen darin enthaltenen Farbinformationen aufnehmen kann. Bei einer Farbtiefe von 24 Bit je Pixel sind das 3 Byte pro Pixel, also enthält die erste Dimension dreimal so viel Elemente wie Pixel in Horizontalrichtung vorhanden sind. Das Element bmWidthBytes der Bitmap-Struktur liefert die Anzahl der Bytes in dieser Richtung. Mit der API-Funktion CopyMemory (RtlMoveMemory) kopiert man anschließend die Bildinformationen in dieses Array und kann die Informationen darin auslesen. Interessant dabei ist, dass der Pixel links oben im Bild sich im Array links unten befindet und der erste Wert der Blau-, das zweite der Grün- und das dritte der Rotwert ist.

Um nicht dauernd mit dem doch recht großen Array zu arbeiten, welches noch viele, für die Auswertung unnötige Informationen enthält, legt man ein zweites Array an, welches nur die relevanten Informationen aufnehmen soll. Darin wird dann lediglich ein boolescher Wert gespeichert, der Auskunft darüber gibt, ob ein Pixel nun eine gewisse Helligkeit unter-, bzw. überschreitet. Zu Beginn habe ich dazu ein zweidimensionales Array verwendet, dessen Größe sich an der Größe des Originalbildes in Pixeln orientiert hatte. Für einen Weißen Pixel wurde Falsch, für einen schwarzen ein Wahr gespeichert. Beim Drehen eines Bildes muss man dann aber alle Elemente durchlaufen, unabhängig davon, ob dieser Pixel überhaupt an eine andere Position muss.

Besser wäre es, wenn man nur die Pixel ansprechen müsste, welche eine gewisse Helligkeit unterschreiten, also schwarz sind. Das habe ich nun gemacht, es wird deshalb das zweidimensionale Array alngPicArr1 angelegt, dessen erste Dimension die X- bzw. Y-Position aufnimmt. Für jeden Pixel, der schwarz ist, existiert also in der zweiten Dimension ab Index 1 ein Element, welches wiederum die zwei Elemente der ersten Dimension enthält. Das erste Element der zweiten Dimension mit dem Index 0 nimmt die Größe des Originalarrays in X- bzw. Y-Richtung auf.

Indem man die Rot-, Grün- und Blauwerte jedes Pixels mit einer gewissen Wichtung multipliziert und die Summe bildet, kann man daraus die Helligkeit ablesen. In diesem Beispiel ist die größte Helligkeit 255, die kleinste 0. Unterschreitet die Helligkeit einen an die Klasse übergebenen Wert, wird dieser als schwarz interpretiert und es wird die Position im Array alngPicArr1 gespeichert. Das Array wird später in der zweiten Dimension unter Beibehaltung des Inhalts (Preserve) so redimensioniert, dass nur noch die gesetzten Pixel plus die Abmessung des Originalbildes übrigbleiben.

Die Funktion RotateTo

Diese Funktion übernimmt einen Winkel, um den das Bild gedreht werden soll und liefert ein Array zurück, welches die gesetzten und nicht gesetzten Elemente des gedrehten Bildes als Boolesche Werte enthält.

Die Größe des Originalbildes wird aus dem Element Null des Arrays mvarPicArr ausgelesen. Mit Hilfe von ein paar Winkelfunktionen kann man nun die Größe errechnen, die das gedrehte Bild benötigt, um alle Pixel des Originalbildes aufzunehmen. Es wird nun ein zweidimensionales Array ablnRot in dieser Größe angelegt und es werden anschließend alle Elemente des Arrays mvarPicArr ab Index 1 ausgelesen. Mit Winkelfunktionen werden nun die Positionen jedes Pixels im gedrehten Bild errechnet und das entsprechende Element im Array ablnRot gesetzt. Am Ende wird dieses Array als Funktionsergebnis zurückgegeben.

Die Funktion GetBarcode

Diese Funktion ist die zentrale Funktion, beziehungsweise Methode der Klasse. Ist die Eigenschaft Picture der Klasse gesetzt, liefert der Aufruf eine Zeichenkette, welche die Ziffern- oder Zeichenfolge des ausgelesenen Barcodes enthält. Zuvor wird noch überprüft, ob nach EAN13, Code39 oder beiden gescannt werden soll, die Funktion wird verlassen, wenn nichts ausgewählt wurde.

Zu Beginn wird ein Array erzeugt, welches alle Winkel aufnimmt, um die das Bild der Reihe nach gedreht werden soll. Damit hat man die Möglichkeit, bestimmte Winkel zu bevorzugen, wie etwa das Drehen um 90- oder 180 Grad. Die anderen Winkel werden durch die Eigenschaft Winkelschrittweite bestimmt. Als erster Winkel wird im Array der Winkel Null gespeichert.

Nun durchläuft man in einer Schleife alle Elemente in dem vorher angesprochenen Array und dreht das Bild mit der Funktion RotateTo um den übergebenen Winkel. Die Informationen des gedrehten Bildes stecken anschließend im Array mvarPicRot.

In einer weiteren Schleife mit der Laufvariablen X werden nun alle Spalten des Arrays, ausgehend von der Mitte nach links, dann nach rechts bis zum Ende, in der Schrittweite mlngStepCol durchlaufen. Um alle Bildpunkte der aktuellen Spalte anzusprechen, wird eine weitere Schleife mit der Laufvariablen Y angelegt und durchlaufen.

Damit ein einzelner fehlerhaft gesetzter Bildpunkt nicht den Scan einer ganzen Spalte beeinflusst, werden bei jedem Bildpunkt der Spalte auch die rechts daneben liegenden Bildpunkte ausgewertet. Die Anzahl wird durch die Variable mbyteWidth festgelegt. Wenn mindestens 50% davon schwarz sind, wird der linke Bildpunkt als schwarz gewertet, ansonsten als weiß. Es wird für jede Spalte eine Zeichenkette mit einer Folge der Buchstaben “W“ (Weißer Bildpunkt) oder “B“ (Schwarzer Bildpunkt) gefüllt. Diese Zeichenkette wird nun an die klasseninterne Prozedur ParseColumn übergeben.

Nach diesem Prozeduraufruf können weitere Schleifenaufrufe verhindert werden, wenn ein Ergebnis gefunden wurde und ein Abbruch nach dem ersten Fund gewünscht wurde. Die Variable mblnExitOnMatch enthält einen Wahrheitswert, der angibt, ob die Schleife nach dem ersten Fund verlassen werden soll, die Variable mblnMatch gibt Auskunft darüber, ob etwas gefunden wurde.

Am Ende stecken alle Ergebnisse in der Collection mcolResult. Alle Elemente dieser Collection werden nun durchlaufen und die Ergebnisse in einer Zeichenkette mit einem Zeilenumbruch dazwischen als Funktionsergebnis zurückgegeben. Außerdem wird noch die Zeitdauer der Suche ermittelt und in der Variablen mdteSearchTime gespeichert.

Die Prozedur ParseColumn

Diese Prozedur erwartet eine Zeichenkette, welche die Bildpunkte einer Spalte als Folge der Zeichen “W“ (White, Hintergrund) und “B“ (Black, Vordergrund) enthält. Mit Hilfe der Ruhezone, die in der Hintergrundfarbe vor dem Beginn und nach dem Ende jeder Barcodezone zu finden ist, wird versucht, den Beginn der für die weitere Auswertung relevanten Barcodezone in der Zeichenkette zu ermitteln.

Die Ruhezone muss mindestens so viele nebeneinander liegende weiße Bildpunkte enthalten, wie in der Variablen mlngPXWhiteZone angegeben ist, außerdem muss sich ein schwarzer Bildpunkt am Ende befinden. Ist mit Instr eine mögliche Ruhezone gefunden worden, wird der Rest der Zeichenkette ab dem Ende der weißen Ruhezone an die Funktion Decode39 und DecodeEAN13 übergeben. Diese liefern, wenn vorhanden, den in Ziffern oder Zeichen übersetzten Barcode zurück. Ein Ergebnis, also eine nichtleere Zeichenkette wird in der Collection mcolResult gespeichert und zwar so, dass ein Ergebnis nur einmal vorkommen kann.

Um das zu realisieren, ist in der Prozedur eine Fehlerbehandlung eingebaut, welche auftretende Fehler ignoriert. Benutzt man beim Hinzufügen eines Elementes zu einer Collection einen Schlüssel, der schon einmal verwendet wurde, wird ein Fehler ausgelöst, die Anweisung zum Hinzufügen wird ignoriert. Benutzt wird als Schlüssel das Ergebnis.

Das Spiel wiederholt sich so lange, wie sich in übrig gebliebenen Zeichenkette eine weitere Ruhezone befindet. Je größer man die Vorgabe einer Ruhezone also setzt, desto weniger kann das Fehlen von ein paar Bildpunkten den Dekodiervorgang in die Länge ziehen. Wählt man die Vorgabe aber größer, als die Ruhezone um den Barcode tatsächlich ist, bleibt die Auswertung erfolglos.

Die Funktion Decode39

Diese Funktion erwartet eine Zeichenkette, welche die Bildpunkte einer Spalte in Form einer Folge der Zeichen “W“ (White, Hintergrund) und “B“ (Black, Vordergrund) enthält. Zurückgeliefert wird, wenn die Zeichenkette am ersten Balken des Barcodes beginnt, die in diesem Barcode steckende Zeichenkette. Ist die Variable mblnCode39 auf Falsch gesetzt, wird die Funktion verlassen.

Zuerst wird die Dicke des ersten Balkens ermittelt. Da das Anfangs- und Endezeichen dieses Codes immer mit einem dünnen schwarzen Balken beginnt und endet, es ist also egal, ob man von rechts, oder von links liest, die Dicke des ersten Balkens ist immer die eines dünnen Balkens. Diese Breite ist ein wichtiges Maß, denn wenn eine Lücke oder ein Balken mindestens 2-mal so breit ist, wird er als gesetzt, also als eine logische 1 angesehen. Um die Auswirkungen kleinerer Fehler auszugleichen, wird bei diesem Code bereits bei einer Breite von mehr als 1,8-mal ein Balken oder eine Lücke als gesetzt gewertet.

Jedes Zeichen besteht aus 5 schwarzen Balken mit 4 eingeschlossenen weißen Lücken, zwischen den Zeichen befindet sich immer eine Lücke. Die Kombination der 9 gesetzten oder nicht gesetzten Balken/Lücken codiert das Zeichen. Es wird für jedes ausgelesene Zeichen eine Zeichenfolge von 9 Ziffern gebildet, welche die ausgelesene Kombination in Form von Einsen oder Nullen enthält. Dieses wird in einer Zeichenkette mit einem Trennzeichen zwischen den Zeichen gespeichert. Die Umwandlung in eine Zeichenkette mit einem Trennzeichen wird deshalb vorgenommen, damit man mit der InStr-Funktion nach bestimmten Zeichen suchen kann, ohne jedesmal in einer Schleife alle Elemente durchlaufen muss.

Nun kann man nachschauen, ob es sich bei dem ersten Zeichen, bestehend aus einer Kombination von 9 Nullen oder Einsen, um das Anfangs- oder Endezeichen handelt. Handelt es sich um das gespiegelte Anfangs- Endezeichen, ist die Leserichtung falsch und die gesamte Zeichenkette wird gespiegelt. Nun ist natürlich nicht sichergestellt, dass nach dem Spiegeln sich auch ein Anfangszeichen am Anfang befindet, deshalb wird solch ein Zeichen gesucht und der vorher liegende Teil weggeschnitten. Findet man kein Anfangszeichen, wird die Funktion ergebnislos verlassen. Findet man kein Endzeichen mit einem vorangestellten Trennzeichen, wird die Funktion auch verlassen.

Anschließend erzeugt man mit der Split-Funktion aus der Zeichenkette ein Stringarray, jedes Element des Arrays enthält dann ein codiertes Zeichen, bestehend aus der Folge von 9 Nullen und Einsen. Nun muss man nur noch die Codefolge in tatsächliche Zeichen umwandeln, dazu wird die Codefolge in der Zeichenkette mstrCode39b gesucht. Die Position um 1 vermindert und durch 10 geteilt, ist ein Zeiger auf das tatsächliche Zeichen in der Zeichenkette mstrCode39a.

Das Endezeichen wird anschließend herausgeschnitten und die restliche Zeichenkette als Funktionsergebnis zurückgegeben. Wünscht man eine Überprüfung, wird die Zeichenkette an die Funktion Code39CheckChar übergeben, welche einen Wahrheitswert liefert, der Auskunft darüber gibt, ob das letzte Zeichen mit einem errechneten Prüfzeichen übereinstimmt. Ist das der Fall, wird das Prüfzeichen abgeschnitten, andernfalls wird als Funktionsergebnis eine leere Zeichenkette zurückgegeben.

Die Funktion Code39CheckChar

Diese Funktion erwartet eine Zeichenkette. Das letzte Zeichen dieser Zeichenkette wird als Prüfzeichen im Code 39 interpretiert. Bei den anderen Zeichen wird die Position in der Codetabelle ermittelt und die Summe dieser Positionen gebildet. Der Divisionsrest dieser Summe durch 43 wird ermittelt und das Zeichen, welches sich in der Codetabelle an dieser Position befindet, mit dem Prüfzeichen verglichen. Stimmen diese überein, wird als Funktionsergebnis der Wahrheitswert “Wahr“ zurückgegeben.

Die Funktion DecodeEAN13

Diese Funktion erwartet eine Zeichenkette, welche die Bildpunkte einer Spalte in Form einer Folge der Zeichen “W“ (White, Hintergrund) und “B“ (Black, Vordergrund) enthält. Zurückgeliefert wird, wenn die Zeichenkette am ersten Balken des Barcodes beginnt, die möglicherweise in diesem Barcode steckende Ziffernkette. Ist die Variable mblnEAN13 auf Falsch gesetzt, wird die Funktion verlassen.

Zu Beginn wird erst einmal die durchschnittliche Modullänge in Pixel ermittelt. Dazu wird das Ende des dritten Modules gesucht und die gefundene Position durch drei geteilt. Der Code EAN13 enthält nämlich zu Beginn und am Ende je drei Module, bestehend aus zwei Balken und einer Lücke (BWB).

Nun kann man daran gehen, die an die Funktion übergebene Zeichenkette in einzelne Module aufzuteilen. Das Ergebnis soll eine Zeichenkette sein, in der für jedes Modul eines der beiden Zeichen “W“ (White, Hintergrund) oder “B“ (Black, Vordergrund) steht. Dazu wird in der Zeichenkette immer der folgende Sprung von “W“ auf “B“ oder umgekehrt gesucht. Die Differenz der gefundenen Position zur Ausgangsposition wird durch die durchschnittliche Modullänge geteilt und man erhält so die Anzahl der Module einer Farbe. Hat man dabei die Position des Sprungs von “W“ auf “B“ benutzt, erhält man die Anzahl weißer Module, bei einem Sprung von “B“ auf “W“ erhält man die Anzahl schwarzer Module.

Jeweils sieben solcher Module, die zwei Balken und zwei Lücken darstellen, kodieren eine einzige Ziffer. Der Barcode selbst enthält 2 Randzeichen (BWB), in der linken und der rechten Hälfte sind je sechs Ziffern mit 7 Modulen angeordnet und dazwischen befindet sich ein Trennzeichen, bestehend aus fünf Modulen (WBWBW). Der gesamte Barcode besteht also aus 95 Modulen (12 Ziffern*7 + 2 Randzeichen *3 + 1 Mittelzeichen *5). Die ersten 95 Zeichen der Zeichenkette strCode werden demnach im weiteren Verlauf ausgewertet, fehlt darin das linke- oder das rechte-Randzeichen, wird die Funktion verlassen.

Wie bereits bei der Erklärung der Prozedur InitEAN beschrieben, existieren drei Zeichensätze (A,B,C). Jede Ziffer darin wird durch zwei Balken und zwei Lücken dargestellt. Jeder Balken und jede Lücke besteht aus mindestens einem Modul, zusammen müssen es immer sieben Module sein. Nimmt man den Zeichensatz A als Grundlage, kann man den Zeichensatz B ermitteln, indem man die Module des Zeichensatzes A invertiert, also aus “B“ ein “W“ und umgekehrt macht.