B4A Library Simple generation EAN barcodes

Simple example of how to generate and display barcodes EAN 8 and EAN 13.

I hope someone can be useful

example.jpg

B4X:
'Code module
'Subs in this code module will be accessible from all modules.
Sub Process_Globals
   'These global variables will be declared once when the application starts.
   'These variables can be accessed from all modules.

End Sub




   '*------------------------------------------------------------------------------
   '*
   '*                                       EANBarCodes
   '* 
   '*      Author : Jordi Torruella
   '*      Date : Aphril 2013
   '* 
   '* 
   '*
   '* 
   '*      FUNCIONES ESPECIFICAS 
   '* 
   '* 
   '*      CreateEANBarCode(strEANCode As String, ThePanel As Panel, ViewCode As Boolean)
   '*
   '*         Proceso publico que Crea el codigo de barras en formato EAN en un panel
   '*                StrEANCode   : Cadena con el codigo EAN a crear
   '*                ThePanel     : Panel donde se creara el codigo
   '*                ViewCode     : Mostrar texto con el codigo EAN
   '* 
   '* 
   '*
   '*       CheckDigitEAN(strEANCode As String) As Boolean
   '*
   '*         Funcion publica que comprueba el digito de control del codigo EAN8 o EAN 13, que devuelve true o false
   '*                Cadena con el codigo a comprobar
   '* 
   '*
   '*       CalculateDigitEAN(strEANCode As String) As String
   '*
   '*          Funcion publica que calcula el digito de control del codigo EAN8 o EAN 13, devuelve un valor string con el valor del digito de control
   '*                StrEANCode   : Cadena con el codigo EAN 
   '* 
   '*
   '* 
   '*
   '*------------------------------------------------------------------------------


   
   
   '*------------------------------------------------------------------------------
   '*
   '* Sub     : CreateEANBarCode
   '*
   '* Proceso público que Crea el código de barras en formato EAN en un panel
   '* 
   '* StrEANCode   : Cadena con el código EAN a crear
   '* ThePanel     : Panel donde se creará el código
   '* ViewCode     : Mostrar texto con el código EAN
   '* 
   '*
    Sub CreateEANBarCode(strEANCode As String, ThePanel As Panel, ViewCode As Boolean)
   
      Dim DrawingCanvas As Canvas
      DrawingCanvas.Initialize(ThePanel) ' Inicializa el Canvas par poder dibujar en el Panel
        
      Dim sngPosX As Short
        Dim sngPosY As Short
        Dim sngScaleX As Int
        Dim strEANBin As String
      Dim sngX1 As Int
      Dim sngX2 As Int
      Dim sngY1 As Int
      Dim sngY2 As Int
      Dim FontSize As Int
      Dim r As Rect
      

        strEANBin = EAN2Bin(strEANCode) ' Devuelve los 0 y 1 correspondeintes al código EAN
   
      ' Establece las dimensiones de la zona donde dibujar el código de barras
      sngX1 = 0
        sngY1 = 0
        sngX2 = ThePanel.Width
        sngY2 = ThePanel.Height
      
      ' Limpiar el panel
      r.Initialize(sngPosX, sngY1, sngX2, sngY2)
      DrawingCanvas.DrawRECT(r, Colors.White, True, 0) ' Borra el contenido anterior
      
      ' Calcula la escala correspondiente según el tamaño de la zona de dibujo y establece el tamaño de la fuente
        sngScaleX = (sngX2 - sngX1) / strEANBin.Length
      FontSize= 8+sngScaleX
      
      ' Establece la posición icial de dibujo del código de barras
        sngPosX = (sngX2-(sngScaleX*strEANBin.Length))/2  ' Centra horizontalmente la impresión
      sngPosY = sngY2
      
        For K = 1 To strEANBin.Length 
            If MID(strEANBin, K, 1) = "1" Then
            If ViewCode=True AND (K>6 AND K<strEANBin.Length-6) Then ' si tiene que mostrar el texto reduce la impresión del código dejando el inicio y final iguales
               sngPosY=sngY2-(FontSize+8)
            Else
               sngPosY=sngY2
            End If
            r.Initialize(sngPosX, sngY1, sngPosX+sngScaleX, sngPosY)
            DrawingCanvas.DrawRECT(r, Colors.Black, True, 0) ' dibuja las columnas del código de barras EAN en el panel
         End If
         sngPosX = sngPosX+sngScaleX ' Avanza a la siguiente posición
        Next
      If ViewCode=True Then ' si se debe mostrar el texto del código
         DrawingCanvas.DrawText(strEANCode,(sngX2 - sngX1) / 2, sngY2-5, Typeface.DEFAULT, FontSize, Colors.Black, "CENTER") ' escribe el texto con el código en el panel centrado horizontalmente
      End If
   End Sub
   
   
   '*------------------------------------------------------------------------------
   '*
   '* Function     : CheckDigitEAN
   '*
   '* Función pública que comprueba el digito de control del código EAN8 o EAN 13
   '* 
   '* StrEANCode   : Cadena con el código a comprobar
   '* 
   '* Devuelve un valor boolean indicando si es correcto  o no
   '* 
   '*
     Sub CheckDigitEAN(strEANCode As String) As Boolean
        Dim dck As String 
      Dim strEANCode2 As String
        Dim realDCK As String
      Dim resultado As Boolean
      dck= RIGHT(strEANCode, 1)' Extrae el supuesto código de control
        If strEANCode.Length=8 OR strEANCode.Length=13 Then ' Comprueba que tenga una numero correcto de caracteres
         strEANCode2=LEFT(strEANCode, strEANCode.Length-1) ' Extrae el código EAN
         realDCK=CalculateDigitEAN(strEANCode2) ' Calcula el código de control real
           If dck = realDCK Then ' Valida el existente con el real
               resultado=True
           Else
               resultado=False
           End If
      Else
            resultado=False      
      End If
      Return resultado
    End Sub


   '*------------------------------------------------------------------------------
   '*
   '* Function     : CalculateDigitEAN
   '*
   '* Función pública que calcula el digito de control del código EAN8 o EAN 13
   '* 
   '* StrEANCode   : Cadena con el código EAN
   '* 
   '* Devuelve un valor del digito de control de la cadena.
   '* (Devolverá -1 si es un código erroneo)
   '* 
   '*
     Sub CalculateDigitEAN(strEANCode As String) As String
        Dim Nums(12) As Int
      Dim i As Int
      Dim dck As Int
        Dim realDCK As String
        i = 1
        If strEANCode.Length = 7 Then
            'Comprobación para EAN8
            Do While i < 8
                Nums(i-1) = MID(strEANCode, i, 1)
                i = i+1
            Loop
            dck = (Nums(6) * 3)
            dck = dck+(Nums(5) * 1)
            dck = dck+(Nums(4) * 3)
            dck = dck+(Nums(3) * 1)
            dck = dck+(Nums(2) * 3)
            dck = dck+(Nums(1) * 1)
            dck = dck+(Nums(0) * 3)
            dck = dck Mod 10
            dck = 10 - dck
            realDCK = dck
        Else
         If strEANCode.Length = 12 Then
               'Comprobación para EAN13
               Do While i < 13
                   Nums(i-1) = MID(strEANCode, i, 1)
                   i = i+1
               Loop
               dck = (Nums(11) * 3)
               dck = dck+(Nums(10) * 1)
               dck = dck+(Nums(9) * 3)
               dck = dck+(Nums(8) * 1)
               dck = dck+(Nums(7) * 3)
               dck = dck+(Nums(6) * 1)
               dck = dck+(Nums(5) * 3)
               dck = dck+(Nums(4) * 1)
               dck = dck+(Nums(3) * 3)
               dck = dck+(Nums(2) * 1)
               dck = dck+(Nums(1) * 3)
               dck = dck+(Nums(0) * 1)
               dck = dck Mod 10
               dck = 10 - dck
               realDCK = dck
           Else
               'No es un EAN8 o EAN13
               realDCK=-1
         End If
        End If
      If realDCK=10 Then realDCK=0
        Return realDCK
    End Sub


   '*------------------------------------------------------------------------------
   '*
   '* Functión  : EAN2Bin
   '*
   '* Función privada que convierte un EAN8 or EAN13 a una secuencia de 1 y 0
   '*
   '* strEANCode:   Código a convertir
   '*
   '* Devuelve la cadena de 1 y 0 correspondiente
   '* 
   '*
   Sub EAN2Bin(strEANCode As String) As String

        Dim K As Int
        Dim strAux As String
        Dim strExit As String
        Dim strCode As String
      Dim num As Int
       Dim valido As Boolean

        valido=True
      strEANCode = strEANCode.trim
        strAux = strEANCode

        If (strAux.Length <> 13) AND (strAux.Length <> 8) Then
            Log("Codigo EAN Incorrecto")
         valido=False
        End If

        For K = 0 To strEANCode.Length - 1
         If IsNumber(MID(strAux,K+1,1)) Then
               If MID(strAux,K+1,1) < "0" OR MID(strAux,K+1,1) > "9" Then
                  Log("caracter incorrecto para el codigo EAN")
               valido=False
               End If
         Else
            valido=False
         End If
        Next
      If valido=True Then
         ' Calculo del codigo inicial par el EAN 13
           If (strAux.Length = 13) Then
            strAux=strAux.SubString(1)
            num=LEFT(strEANCode, 1)
               Select Case num
                   Case 0
                       strCode = "000000"
                   Case 1
                       strCode = "001011"
                   Case 2
                       strCode = "001101"
                   Case 3
                       strCode = "001110"
                   Case 4
                       strCode = "010011"
                   Case 5
                       strCode = "011001"
                   Case 6
                       strCode = "011100"
                   Case 7
                       strCode = "010101"
                   Case 8
                       strCode = "010110"
                   Case 9
                       strCode = "011010"
               End Select
           Else
            '  Código inicial para EAN 8
               strCode = "0000"
           End If
           '  Indicador de inicio del código
           strExit = "000101"

           '  Primera parte del código
           For K = 1 To strAux.Length/2
            num=MID(strAux, K, 1)
               Select Case num
                   Case 0
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0001101", "0100111")
                   Case 1
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0011001", "0110011")
                   Case 2
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0010011", "0011011")
                   Case 3
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0111101", "0100001")
                   Case 4
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0100011", "0011101")
                   Case 5
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0110001", "0111001")
                   Case 6
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0101111", "0000101")
                   Case 7
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0111011", "0010001")
                   Case 8
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0110111", "0001001")
                   Case 9
                       strExit = strExit & IIF(MID(strCode, K, 1) = "0", "0001011", "0010111")
               End Select
           Next

           '  Separador central del código
           strExit = strExit & "01010"

           '  Segunda parte del código
           For K = (strAux.Length/2) + 1 To strAux.Length
             num=MID(strAux, K, 1)
               Select Case num
                   Case 0
                       strExit = strExit & "1110010"
                   Case 1
                       strExit = strExit & "1100110"
                   Case 2
                       strExit = strExit & "1101100"
                   Case 3
                       strExit = strExit & "1000010"
                   Case 4
                       strExit = strExit & "1011100"
                   Case 5
                       strExit = strExit & "1001110"
                   Case 6
                       strExit = strExit & "1010000"
                   Case 7
                       strExit = strExit & "1000100"
                   Case 8
                       strExit = strExit & "1001000"
                   Case 9
                       strExit = strExit & "1110100"
               End Select
           Next
         '  Indicador final del código
         strExit = strExit & "101000"
      Else
         strExit=""
      End If
        Return strExit
    End Sub
   
   '*------------------------------------------------------------------------------
   '*
   '* Function     : IIF
   '*
   '* Función pública que emula la sentencia IIF de VB.NET
   '* 
   '* Validate  : Cadena a validar
   '* istrue    : Valor a devolver en el caso de que la validación sea positiva
   '* isfalse   : Valor a devolver en el caso de que la validación sea negativa   
   '* 
   '* Devuelve el valor correspondiente a la validación
   '* 
   '*
   Sub IIF(validate As Boolean, istrue As Object, isfalse As Object) As Object
      If validate Then Return istrue Else Return isfalse
   End Sub
   
   '*------------------------------------------------------------------------------
   '*
   '* Function     : MID
   '*
   '* Función pública que emula la sentencia MID de VB.NET
   '* Extrae y devuelve parte de una cadena de caracteres.
   '* 
   '* value     : Cadena de caracteres original.
   '* in        : Posición del primer caracter de la cadena a extraer
   '* len       : Longitud de la cadena a extraer   
   '* 
   '* Devuelve un string con la parte seleccionada de la cadena
   '* 
   '*
   Sub MID(value As String, in As Int, len As Int) As String
      Dim cadena2 As String
      If in-1+len<=value.Length Then
         cadena2=value.SubString2(in-1, in+len-1)
      Else
         cadena2=""
      End If
      Return cadena2
   End Sub
   
   '*------------------------------------------------------------------------------
   '*
   '* Function     : LEFT
   '*
   '* Función pública que emula la sentencia LEFT de VB.NET
   '* Extrae y devuelve parte de una cadena de caracteres, comenzando por la izquierda de la cadena original.
   '* 
   '* value    : Cadena de caracteres original.
   '* len      : Longitud de la cadena a extraer   
   '* 
   '* Devuelve un string con la parte seleccionada de la cadena
   '* 
   '*
   Sub LEFT(value As String, len As Int) As String
      If len<= value.Length Then
         Return value.SubString2(0, len)
      End If
   End Sub
   
   '*------------------------------------------------------------------------------
   '*
   '* Function     : RIGHT
   '*
   '* Función pública que emula la sentencia RIGHT de VB.NET
   '* Extrae y devuelve parte de una cadena de caracteres, comenzando por la derecha de la cadena original.
   '* 
   '* value    : Cadena de caracteres original.
   '* len      : Longitud de la cadena a extraer   
   '* 
   '* Devuelve un string con la parte seleccionada de la cadena
   '* 
   '*
   Sub RIGHT(value As String, len As Int) As String
      If len<= value.Length Then
         Return value.SubString(value.Length-(len))
      End If
   End Sub


Zip file attached with a demo app


Excuse my bad English
 

Attachments

  • Demo.zip
    9.9 KB · Views: 503
Last edited:

javiers

Active Member
Licensed User
Longtime User
Thanks for sharing the code. A greeting.

Gracias por compartir el código. Un saludo.
 

JOTHA

Well-Known Member
Licensed User
Longtime User
I tried to start compiling, but there was a message:
Compiling generated Java code. Error
javac 1.7.0_17
javac: file not found: src\barcode\demo\designerscripts\*.java
Usage: javac <options> <source files>
use -help for a list of possible options

Is there a special library needed?
 

JOTHA

Well-Known Member
Licensed User
Longtime User
I deactivatet the designerscript like this:
'All variants script
'Button1.Right=100%x
'EditText1.Width=Button1.Left-5
'Panel1.Width=100%x-70
'Panel1.Height=(100%y-Panel1.Top)/2
... and now it compiled the code.
 
Top