Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Proyecto AjpdSoft: Foros

AjpdSoft :: Ver tema - Generar código de barras EAN 8 y 13 con Visual Basic
Foros de discusión Buscar Perfil FAQ Iniciar sesión
Information Generar código de barras EAN 8 y 13 con Visual Basic

Publicar nuevo tema Responder al tema
Foros de discusión » VB.Net, C# .Net, Visual Studio .Net   
Ver tema anterior :: Ver tema siguiente
AutorMensaje
varios
Magnífico usuario


Registrado: Oct 10, 2006
Mensajes: 2092

Asunto: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando

¿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.
MensajePublicado:
Vie Abr 06, 2007 4:55 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



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

  codigoBarrasF = formarCodBarras(Left(txtCodigoBarras.Text, tipoCodBarras))
  txtCodigoBarras.Text = codigoBarrasF
  dibujarCodigoBarras
 
cSalir:
  Exit Sub

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

  digCentral = IIf(logitudCodigoBarras = 8, 5, 8)
  With imgEAN
    .Cls
    .BackColor = vbWhite
    .FontSize = 12
    .DrawWidth = 2
    lposX = 11

    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

Private Sub imprimirCodigoEAN()
  Dim i As Integer
 
  On Error GoTo cError
 
  With Printer
    .ColorMode = vbPRCMMonochrome
    .PrintQuality = -2 'calidad baja
    .CurrentY = 200
    .CurrentX = 200
    .Font = "Courier New"
    .FontBold = True
    .FontSize = 10
    Printer.Print "Código de Barras EAN: " & codigoBarrasF
    .FontBold = False
    Printer.PaintPicture imgEAN.Image, 200, 600
    Printer.Print
    .EndDoc
    MsgBox "Imprimiendo código de barras EAN: " & codigoBarrasF _
        & vbCrLf & "Puerto: " & .Port, vbInformation, App.Title
  End With
   
cSalir:
  Exit 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



El del módulo variables: mdVariables.bas
Código:

Public Mdl(2), MdlLeft

Function iniciarAr()
  Mdl(0) = Array("0001101", "0011001", "0010011", "0111101", "0100011", "0110001", "0101111", "0111011", "0110111", "0001011")
  Mdl(1) = Array("0100111", "0110011", "0011011", "0100001", "0011101", "0111001", "0000101", "0010001", "0001001", "0010111")
  Mdl(2) = Array("1110010", "1100110", "1101100", "1000010", "1011100", "1001110", "1010000", "1000100", "1001000", "1110100")
  MdlLeft = Array("000000", "001011", "001101", "001110", "010011", "011001", "011100", "010101", "010110", "011010")
End Function
MensajePublicado:
Vie Abr 06, 2007 7:51 pm
Top of PageVer perfil de usuario
varios
Magnífico usuario


Registrado: Oct 10, 2006
Mensajes: 2092

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



Anuncios



alonsojpd escribió:
Tal vez te sirva este código:
* El del formulario principal: formMenuPrincipal.frm
Código:

Option Explicit




¿podrías colocar el código fuente completo en Visual Basic en la sección descargas? nos sería de gran utilidad.
MensajePublicado:
Dom Abr 08, 2007 7:29 am
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



Anuncios



varios escribió:
alonsojpd escribió:
Tal vez te sirva este código:
* El del formulario principal: formMenuPrincipal.frm
Código:

Option Explicit




¿podrías colocar el código fuente completo en Visual Basic en la sección descargas? nos sería de gran utilidad.



Por supuesto, acabamos de añadir la descarga, la dirección es:

http://www.ajpdsoft.com/modules.php?name=Downloads&d_op=viewdownloaddetails&lid=175
MensajePublicado:
Dom Abr 08, 2007 8:14 am
Top of PageVer perfil de usuario
ajvprof
Usuario


Registrado: Apr 25, 2007
Mensajes: 2

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



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.
MensajePublicado:
Mie Abr 25, 2007 7:08 pm
Top of PageVer perfil de usuario
alonsojpd
Administrador/Moderador


Registrado: Sep 16, 2003
Mensajes: 2687

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



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.
MensajePublicado:
Jue Abr 26, 2007 9:34 am
Top of PageVer perfil de usuario
ajvprof
Usuario


Registrado: Apr 25, 2007
Mensajes: 2

Asunto: Re: Generar código de barras EAN 8 y 13 con Visual Basic Responder citando



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

    digCentral = IIf(logitudCodigoBarras = 8, 5, 8)
 
    With imgEAN
        .Cls
        .BackColor = vbWhite
        .FontSize = 12
        .DrawWidth = 2
       
        lposX = 11

        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.
MensajePublicado:
Vie Jun 15, 2007 11:34 am
Top of PageVer perfil de usuario
fjenguidanos
Usuario


Registrado: Jun 27, 2007
Mensajes: 1

Asunto: Codigo EAN 13 Responder citando

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. icon_rolleyes.gif
MensajePublicado:
Mie Jun 27, 2007 8:43 am
Top of PageVer perfil de usuario
davidcr85
Usuario


Registrado: Feb 09, 2012
Mensajes: 1

Asunto: Responder citando

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.
MensajePublicado:
Jue Feb 09, 2012 1:50 am
Top of PageVer perfil de usuario
eva
Usuario


Registrado: Feb 08, 2013
Mensajes: 1

Asunto: Consulta. Responder citando

Muchas gracias por el ejemplo.

Me gustaria reducir el tamaño de impresión de codigo de barras pero no lo consigo alguna idea.?
MensajePublicado:
Vie Feb 08, 2013 10:03 am
Top of PageVer perfil de usuario
mygoldxp
Usuario


Registrado: Aug 14, 2013
Mensajes: 1

Asunto: Responder citando

Muchas gracias por el aporte icon_smile.gif es lo que andaba buscando.
Lo único.... si no es mucho pedir... hay alguna manera de obtenerla en versión VB .NET??
Por favor.

Graciasss
MensajePublicado:
Mie Ago 14, 2013 3:14 pm
Top of PageVer perfil de usuario
Mostrar mensajes de anteriores:   
Todas las horas son GMT - 1 Horas
Publicar nuevo tema Responder al tema
Foros de discusión » VB.Net, C# .Net, Visual Studio .Net  

Cambiar a:  
Key
  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