Simple example of how to generate and display barcodes EAN 8 and EAN 13.
I hope someone can be useful
Zip file attached with a demo app
Excuse my bad English
I hope someone can be useful
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 SubZip file attached with a demo app
Excuse my bad English
Last edited:
