Asunto: Generar código de barras EAN 8 y 13 con Visual Basic
¿cómo puedo generar códigos de barras EAN 8 y EAN 13 con Visual Basic sin utilizar componentes adicionales?
Me gustaría poder guardarlos en bmp, e incluso poder imprimirlos.
Publicado:
Vie Abr 06, 2007 4:55 pm
alonsojpd Administrador/Moderador
Registrado: Sep 16, 2003 Mensajes: 2687
Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic
Anuncios
varios escribió:
¿cómo puedo generar códigos de barras EAN 8 y EAN 13 con Visual Basic sin utilizar componentes adicionales?
Me gustaría poder guardarlos en bmp, e incluso poder imprimirlos.
Tal vez te sirva este código:
* El del formulario principal: formMenuPrincipal.frm
Código:
Option Explicit
Dim codigoBarrasF As String
Dim logitudCodigoBarras As Long
Private Sub bGenerar_Click()
Dim tipoCodBarras As Byte
On Error GoTo cError
Select Case Len(txtCodigoBarras.Text)
Case 0 To 6:
msgAviso "Introduzca 8 o 13 caracteres numéricos."
Exit Sub
Case 7 To 11:
tipoCodBarras = 7
logitudCodigoBarras = 8
Case 12 To 20:
tipoCodBarras = 12
logitudCodigoBarras = 13
End Select
cError:
Select Case Err.Number
Case 13: msgAviso "Introduzca sólo números."
Case Else: msgAviso "Se ha producido un error al intentar " + _
"generar el código de barras: " & _
Err.Number + " " + Err.Description
End Select
GoTo cSalir
End Sub
Private Sub Form_Load()
iniciarAr
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set formMenuPrincipal = Nothing
End Sub
Private Sub dibujarCodigoBarras()
Dim digCentral As Byte, lposX As Long, i As Integer, j As Integer
Dim lCurNum As Long, lPrimerNum As Long, iMod As Integer
For i = 1 To logitudCodigoBarras
lCurNum = CLng(Mid(codigoBarrasF, i, 1))
If i = 1 Then
GuardBar lposX
lPrimerNum = lCurNum
.CurrentX = 2
.CurrentY = 66
imgEAN.Print IIf(logitudCodigoBarras = 8, "<", lPrimerNum)
End If
If i <> 1 Or logitudCodigoBarras = 8 Then
If i < digCentral Then
Select Case logitudCodigoBarras
Case 8:
iMod = 0
Case 13:
iMod = medIn(MdlLeft(lPrimerNum), i - 1)
End Select
Else
iMod = 2
End If
End If
If i = digCentral Then
lposX = lposX + 2
GuardBar lposX
lposX = lposX + 1
End If
For j = 1 To 7
If medIn(Mdl(iMod)(lCurNum), j) = 1 Then
dibujarLinea lposX, 0
End If
lposX = lposX + 1
Next j
.CurrentX = lposX - 8
.CurrentY = 66
imgEAN.Print lCurNum
Next i
.CurrentX = lposX + 8
.CurrentY = 66
If logitudCodigoBarras = 8 Then
imgEAN.Print ">"
End If
GuardBar lposX
End With
End Sub
Private Sub txtCodigoBarras_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13:
bGenerar_Click
Exit Sub
Case 8, 48 To 57:
Exit Sub
Case Else
KeyAscii = 0
End Select
End Sub
Private Sub zEan_Click(Index As Integer)
Dim rutaNombreFichEAN As String
Select Case Index
Case 0: bGenerar_Click
Case 1
If logitudCodigoBarras <> 0 Then
rutaNombreFichEAN = App.Path & "\EAN-" & codigoBarrasF & ".bmp"
If Dir(rutaNombreFichEAN) <> "" Then
Kill rutaNombreFichEAN
End If
SavePicture imgEAN.Image, rutaNombreFichEAN
MsgBox "Código de barras EAN guardado: " & _
Chr(34) & rutaNombreFichEAN & Chr(34)
Else
msgAviso "No hay código de barras EAN para guardar."
End If
Case 2
If logitudCodigoBarras <> 0 Then
imprimirCodigoEAN
Else
msgAviso "No ha generado código de barras para imprimir."
End If
Case 4:
Unload Me
End Select
End Sub
cError:
Printer.KillDoc
MsgBox "Se ha producido un error al intetar imprimir el código de barras: " & _
Err.Description, vbExclamation
GoTo cSalir
End Sub
Private Sub GuardBar(posX As Long)
dibujarLinea posX, 6
dibujarLinea posX + 2, 6
posX = posX + 3
End Sub
Private Sub dibujarLinea(posX As Long, bExten As Byte)
imgEAN.Line (posX, 5)-(posX, 66 + bExten)
End Sub
El del módulo funciones: mdFunciones.bas
Código:
Option Explicit
Function formarCodBarras(ByVal codBarrasOr As String) As String
formarCodBarras = codBarrasOr & comprobarDigitoControl(codBarrasOr)
End Function
Function comprobarDigitoControl(ByVal codigoBarras As String) As Byte
Dim digito As Byte, calTotal As Byte
Dim codTmp As String, bPal As Byte, numC As Byte
Select Case Len(codigoBarras)
Case 7, 12
codTmp = Right$("0000000000000000" & codigoBarras, 17)
bPal = 3
For numC = 1 To 17
calTotal = calTotal + Val(Mid$(codTmp, numC, 1)) * bPal
bPal = 4 - bPal
Next
digito = calTotal Mod 10
digito = IIf(digito = 0, 0, 10 - digito)
End Select
comprobarDigitoControl = digito
End Function
Sub msgAviso(ByVal textoAviso As String)
MsgBox textoAviso, vbExclamation, App.Title
End Sub
Function medIn(ByVal vTextoTmp, ByVal vPosicion)
medIn = CInt(Mid(vTextoTmp, vPosicion, 1))
End Function
Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic
Anuncios
Muy buenas. Tengo el mismo problema que se plantea en la consulta inicial y que solucionaste muy amablemente. Pero me ha surgido una dificultad. El código de barras que se genera en la versión desarrollada en VB 6.0, o lo genera mal o no es EAN 13. En cambio la versión 1.0.0.26 que creo esta desarrollada en Delphi genera un código EAN 13 perfecto. ¿Me podrías confirmar esto?. ¿Si existe algún error en el código de VB, se podría solucionar? Estoy parado en un proyecto por este problema. Gracias anticipadas.
Publicado:
Mie Abr 25, 2007 7:08 pm
alonsojpd Administrador/Moderador
Registrado: Sep 16, 2003 Mensajes: 2687
Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic
Anuncios
ajvprof escribió:
Muy buenas. Tengo el mismo problema que se plantea en la consulta inicial y que solucionaste muy amablemente. Pero me ha surgido una dificultad. El código de barras que se genera en la versión desarrollada en VB 6.0, o lo genera mal o no es EAN 13. En cambio la versión 1.0.0.26 que creo esta desarrollada en Delphi genera un código EAN 13 perfecto. ¿Me podrías confirmar esto?. ¿Si existe algún error en el código de VB, se podría solucionar? Estoy parado en un proyecto por este problema. Gracias anticipadas.
Es cierto, tras realizar una comprobación hemos observado que la aplicación genera un código de barras que no es válido. Estamos tratando de averigüar el problema, en breve colocaremos una nueva versión con el problema solucionado.
Gracias por el aviso.
Publicado:
Jue Abr 26, 2007 9:34 am
ajvprof Usuario
Registrado: Apr 25, 2007 Mensajes: 2
Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic
Anuncios
Creo que he conseguido localizar el problema.
Este consiste en que las barras pertenecientes al primer dígito del código se pintan dos veces. La solución es modificar el procedimiento dibujarCodigoBarras quedando de la siguiente forma:
Código:
Private Sub dibujarCodigoBarras()
Dim digCentral As Byte, lposX As Long, i As Integer, j As Integer
Dim lCurNum As Long, lPrimerNum As Long, iMod As Integer
For i = 1 To logitudCodigoBarras
lCurNum = CLng(Mid(codigoBarrasF, i, 1))
If i = 1 Then
GuardBar lposX
lPrimerNum = lCurNum
.CurrentX = 2
.CurrentY = 66
imgEAN.Print IIf(logitudCodigoBarras = 8, "<", lPrimerNum)
End If
If i <> 1 Or logitudCodigoBarras = 8 Then
If i < digCentral Then
Select Case logitudCodigoBarras
Case 8:
iMod = 0
Case 13:
iMod = medIn(MdlLeft(lPrimerNum), i - 1)
End Select
Else
iMod = 2
End If
End If
If i = digCentral Then
lposX = lposX + 2
GuardBar lposX
lposX = lposX + 1
End If
If i <> 1 Then ‘----->Nueva línea
For j = 1 To 7
If medIn(Mdl(iMod)(lCurNum), j) = 1 Then
dibujarLinea lposX, 0
End If
lposX = lposX + 1
Next j
.CurrentX = lposX - 8
.CurrentY = 66
imgEAN.Print lCurNum
End If ‘------> Nueva línea
Next i
.CurrentX = lposX + 8
.CurrentY = 66
If logitudCodigoBarras = 8 Then
imgEAN.Print ">"
End If
GuardBar lposX
End With
End Sub
Seria interesante que los titulares del programa validases esta reparación.
Publicado:
Vie Jun 15, 2007 11:34 am
fjenguidanos Usuario
Registrado: Jun 27, 2007 Mensajes: 1
Asunto: Codigo EAN 13
Hola a todos: Muchas gracias por facilitar a usuarios novatos como yo el código para el manejo de los codigos ean 13. ¿Sería posible que facilitarais el código equivalente en .net (visual basic)? Os estaría profundamente agradecido.
Publicado:
Mie Jun 27, 2007 8:43 am
davidcr85 Usuario
Registrado: Feb 09, 2012 Mensajes: 1
Asunto:
Muchas gracias por el aporte y por el arreglo. ! Yo ahorita estoy en el desarrollo de un sistema de punto de venta y me será de gran de ayuda aunque aclaro aún no lo he validado con un lector de barras a simple vista comparando con algunos productos parece estar bien.
Ya les estare comentando en algunas semanas su funcionamiento.. Quizas alguien mas aqui lo pueda probar antes que yo y comentar.
Publicado:
Jue Feb 09, 2012 1:50 am
eva Usuario
Registrado: Feb 08, 2013 Mensajes: 1
Asunto: Consulta.
Muchas gracias por el ejemplo.
Me gustaria reducir el tamaño de impresión de codigo de barras pero no lo consigo alguna idea.?
Publicado:
Vie Feb 08, 2013 10:03 am
mygoldxp Usuario
Registrado: Aug 14, 2013 Mensajes: 1
Asunto:
Muchas gracias por el aporte es lo que andaba buscando.
Lo único.... si no es mucho pedir... hay alguna manera de obtenerla en versión VB .NET??
Por favor.
Puede publicar nuevos temas en este foro No puede responder a temas en este foro No puede editar sus mensajes en este foro No puede borrar sus mensajes en este foro No puede votar en encuestas en este foro
Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A