Portal    Foro    Buscar    FAQ    Registrarse    Conectarse


Publicar nuevo tema  Responder al tema 
Página 1 de 3
Ir a la página 1, 2, 3  Siguiente
 
Código Para Generar Códigos De Barras
Autor Mensaje
Responder citando   Descargar mensaje  
Mensaje Código Para Generar Códigos De Barras 
 
Hola,

Aunque esta en Vb  os dejo el código fuente y las fuentes para:
EAN-13
EAN-128
PDF417
code39
code128

por si es de vuestro interés

Saludos
 



 
última edición por ljma el Lunes, 27 Diciembre 2010, 20:19; editado 1 vez 
ljma - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
No, tengo visual basic...., no puedo ver como funciona... pero seguro que es interesante hacer un componente para Gambas2

Saludos
 




===================
Blog personal
Web: SoloGambas seleccion de articulos dedicados a Gambas
Visita el Curso de Gambas3 ¡¡¡Gratuito!!!
 
jsbsan - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
Hola,

Aunque no soy un experto, en realidad no es difícil. Lo que es más complicado es hacer las fuentes (que ya las tenemos en el archivo).
Por ejemplo, para el EAN13 lo único que hay que hacer es instalar la fuente en el sistema y posteriormente seleccionar esa fuente, ejemplo en un label, y pasarle los 12 dígitos + el de control.
Y así en todos. Lógicamente se compican los cálculos y la forma de meter los datos cuanto más información admite el código.
Aunque no tengas Vb puedes ver todo el código (los algoritmos) editando los ficheros con gedit (o con el que uses) y si te interesa alguno en concreto te puedo enviar unos pantallazos.

Para finales de  enero intentaré hacer un componente para manejar EAN128 (el EAN13 es muy sencillo y no merece la pena y el PDF417 me da mucha pereza...) que puede ser muy útil. (Lo bueno sería hacer tambien las fuentes pero eso se me escapa).

Saludos
 



 
última edición por ljma el Martes, 28 Diciembre 2010, 20:50; editado 3 veces 
ljma - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
ljma:

Lo suyo es hacer un componente de todos los tipos que haya, para que sea mas útil...

¿que archivos de VB contienen el código (los algoritmos), ya que hay varios tipos en el archivo comprimido...?

Citar:
y si te interesa alguno en concreto te puedo enviar unos pantallazos.


Si enviamelos, para cuando me ponga vea por donde empezar....

Si te hace falta alguna ayuda, pues ya sabes, cuenta conmigo...

Saludos

Julio
 




===================
Blog personal
Web: SoloGambas seleccion de articulos dedicados a Gambas
Visita el Curso de Gambas3 ¡¡¡Gratuito!!!
 
jsbsan - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
jsbsan escribió: [Ver mensaje]
ljma:


¿que archivos de VB contienen el código (los algoritmos), ya que hay varios tipos en el archivo comprimido...?


Julio


Los  extencion frm

code128.frm

Option Explicit
Private CodeClair$, CodeBarre$
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()
  Unload Me
End Sub

Private Sub Command2_Click()
  Clipboard.Clear
  Clipboard.SetText label5.Text
End Sub

Private Sub label1_Click()
  Text1.SetFocus
End Sub

Private Sub Label6_Click()
  ShellExecute Me.hWnd, "open", "http://grandzebu.net", vbNullString, vbNullString, 3
End Sub

Private Sub Label8_Click()
  ShellExecute Me.hWnd, "open", "http://grandzebu.net/informatique/codbar-en/codbar.htm", vbNullString, vbNullString, 3
End Sub

Private Sub Text1_Change()
  Dim CodeBarre$
  CodeBarre$ = code128$(Text1)
  label5.Text = CodeBarre$
  label1.Text = CodeBarre$
End Sub

Public Function code128$(chaine$)
  'Cette fonction est régie par la Licence Générale Publique Amoindrie GNU (GNU LGPL)
  'This function is governed by the GNU Lesser General Public License (GNU LGPL)
  'V 2.0.0
  'Paramètres : une chaine
  'Parameters : a string
  'Retour : * une chaine qui, affichée avec la police CODE128.TTF, donne le code barre
  '         * une chaine vide si paramètre fourni incorrect
  'Return : * a string which give the bar code when it is dispayed with CODE128.TTF font
  '         * an empty string if the supplied parameter is no good
  Dim i%, checksum&, mini%, dummy%, tableB As Boolean
  code128$ = ""
  If Len(chaine$) > 0 Then
  'Vérifier si caractères valides
  'Check for valid characters
    For i% = 1 To Len(chaine$)
      Select Case Asc(Mid$(chaine$, i%, 1))
      Case 32 To 126, 203
      Case Else
        i% = 0
        Exit For
      End Select
    Next
    'Calculer la chaine de code en optimisant l'usage des tables B et C
    'Calculation of the code string with optimized use of tables B and C
    code128$ = ""
    tableB = True
    If i% > 0 Then
      i% = 1 'i% devient l'index sur la chaine / i% become the string index
      Do While i% <= Len(chaine$)
        If tableB Then
          'Voir si intéressant de passer en table C / See if interesting to switch to table C
          'Oui pour 4 chiffres au début ou à la fin, sinon pour 6 chiffres / yes for 4 digits at start or end, else if 6 digits
          mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
          GoSub testnum
          If mini% < 0 Then 'Choix table C / Choice of table C
            If i% = 1 Then 'Débuter sur table C / Starting with table C
              code128$ = Chr$(210)
            Else 'Commuter sur table C / Switch to table C
              code128$ = code128$ & Chr$(204)
            End If
            tableB = False
          Else
            If i% = 1 Then code128$ = Chr$(209) 'Débuter sur table B / Starting with table B
          End If
        End If
        If Not tableB Then
          'On est sur la table C, essayer de traiter 2 chiffres / We are on table C, try to process 2 digits
          mini% = 2
          GoSub testnum
          If mini% < 0 Then 'OK pour 2 chiffres, les traiter / OK for 2 digits, process it
            dummy% = Val(Mid$(chaine$, i%, 2))
            dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 105)
            code128$ = code128$ & Chr$(dummy%)
            i% = i% + 2
          Else 'On n'a pas 2 chiffres, repasser en table B / We haven't 2 digits, switch to table B
            code128$ = code128$ & Chr$(205)
            tableB = True
          End If
        End If
        If tableB Then
          'Traiter 1 caractère en table B / Process 1 digit with table B
          code128$ = code128$ & Mid$(chaine$, i%, 1)
          i% = i% + 1
        End If
      Loop
      'Calcul de la clé de contrôle / Calculation of the checksum
      For i% = 1 To Len(code128$)
        dummy% = Asc(Mid$(code128$, i%, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 105)
        If i% = 1 Then checksum& = dummy%
        checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
      Next
      'Calcul du code ASCII de la clé / Calculation of the checksum ASCII code
      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 105)
      'Ajout de la clé et du STOP / Add the checksum and the STOP
      code128$ = code128$ & Chr$(checksum&) & Chr$(211)
    End If
  End If
  Exit Function
testnum:
  'si les mini% caractères à partir de i% sont numériques, alors mini%=0
  'if the mini% characters from i% are numeric, then mini%=0
  mini% = mini% - 1
  If i% + mini% <= Len(chaine$) Then
    Do While mini% >= 0
      If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
End Function

 

 



 
codificador - Ver perfil del usuarioEnviar mensaje privado 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
en los ejemplos del gambas, tenéis un programa de códigos de barras, e incluso los imprime.


Un saludo
 



 
tururu - Ver perfil del usuarioEnviar mensaje privado 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
Tienes razón... no lo recordaba...     

Aunque solo es del sistema EAN13, pero puede ser un buen inicio.

Como dice Soplo, no vamos a inventar la rueda, aprovechamos lo que ya esta echo...

Saludos...
 




===================
Blog personal
Web: SoloGambas seleccion de articulos dedicados a Gambas
Visita el Curso de Gambas3 ¡¡¡Gratuito!!!
 
jsbsan - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
Hola,

Citar:
ljma:

Lo suyo es hacer un componente de todos los tipos que haya, para que sea mas útil...

¿que archivos de VB contienen el código (los algoritmos), ya que hay varios tipos en el archivo comprimido...?

    Citar:
    y si te interesa alguno en concreto te puedo enviar unos pantallazos.

Si enviamelos, para cuando me ponga vea por donde empezar....


Un componente que sirva para todos....ufff...es muy ambicioso. Soy más partidario de un control para cada tipo al menos hasta que estén maduros.

Dime uno para empezar y hoy por la noche te pego los pantallazos.

Saludos
 



 
ljma - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
Pues es que tu ves mas interesante:

   EAN128

Saludos
 




===================
Blog personal
Web: SoloGambas seleccion de articulos dedicados a Gambas
Visita el Curso de Gambas3 ¡¡¡Gratuito!!!
 
jsbsan - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Responder citando   Descargar mensaje  
Mensaje Re: Código Para Generar Códigos De Barras 
 
Hola,

Te adjunto varios pantallazos que se corresponden con los Identificadores de Aplicación (00) Código seriado de la Unidad de envío (n2+n18  =>17dígitos) y Código de agrupación (n2+n14 =>13 dígitos) (hay más de 100).
 ean128_1
 ean128_2
 ean128_3
 ean128_4
 ean128_5

Archivo FOchamp.frm
Option Explicit
Private listeAI As New Collection

Private Sub BTannuler_Click()
  Me.Hide
End Sub

Private Sub BToui_Click()
  COvaleur.MaxLength = COvaleur.MaxLength + 1
  If Check1 = vbChecked Then Call AddChecksum
  If Option2 And Len(COvaleur) < Val(COlg) Then COvaleur = COvaleur & Chr$(207)
  FOean128.COliste.AddItem CoAI & COvaleur
  Me.Hide
End Sub

Private Sub CoAI_Change()
  Call CheckControl
End Sub

Private Sub CoAI_KeyPress(KeyAscii As Integer)
  If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0
End Sub

Private Sub COlg_Change()
  Call CheckControl
End Sub

Private Sub COlg_KeyPress(KeyAscii As Integer)
  If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0
End Sub

Private Sub COliste_Click()
  Dim MyAI As New APpId
  If COliste.ListIndex > 0 Then
    Set MyAI = listeAI.Item(COliste.ListIndex)
    CoAI = MyAI.id
    COlg = MyAI.longueur
    If MyAI.fixe Then Option1 = True Else Option2 = True
    If MyAI.checksum Then Check1 = 1 Else Check1 = 0
    If MyAI.alphanum Then Check2 = 0 Else Check2 = 1
  Else
    CoAI = ""
    COlg = ""
    Option1 = True
    Check1 = 0
    Check2 = 0
  End If
  COvaleur = ""
  Call CheckControl
  If COvaleur.Enabled Then COvaleur.SetFocus
End Sub

Private Sub COvaleur_Change()
  Call CheckControl
End Sub

Private Sub COvaleur_KeyPress(KeyAscii As Integer)
  If KeyAscii <> 8 Then
    If Check2.Value = vbChecked Then
      If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
    End If
  End If
End Sub

Private Sub Form_Activate()
  COliste.ListIndex = 0
  CoAI = ""
  COlg = ""
  Option1.Value = True
  Check1.Value = vbUnchecked
  Check2.Value = vbUnchecked
  COvaleur = ""
  COliste.SetFocus
End Sub

Private Sub Form_Load()
  Dim chaine$, pos%, MyAI As New APpId
  COliste.AddItem "     <AI non répertorié / AI not listed>"
  'Charger le fichier des AIs / Load the AIs file
  Open App.Path & "\ais.txt" For Input As #1
  Do While Not EOF(1)
    Line Input #1, chaine$
    If Left$(chaine$, 1) <> ";" Then
      pos% = InStr(chaine$, vbTab)
      MyAI.id = Left$(chaine$, pos% - 1)
      chaine$ = Mid$(chaine$, pos% + 1)
      pos% = InStr(chaine$, vbTab)
      MyAI.desc = Left$(chaine$, pos% - 1)
      chaine$ = Mid$(chaine$, pos% + 1)
      pos% = InStr(chaine$, vbTab)
      MyAI.longueur = Val(Left$(chaine$, pos% - 1))
      chaine$ = Mid$(chaine$, pos% + 1)
      pos% = InStr(chaine$, vbTab)
      MyAI.fixe = IIf(Left$(chaine$, pos% - 1) = "1", True, False)
      chaine$ = Mid$(chaine$, pos% + 1)
      pos% = InStr(chaine$, vbTab)
      MyAI.checksum = IIf(Left$(chaine$, pos% - 1) = "1", True, False)
      chaine$ = Mid$(chaine$, pos% + 1)
      MyAI.alphanum = IIf(chaine$ = "1", True, False)
      listeAI.Add MyAI
      COliste.AddItem Left$(MyAI.id & Space$(5), 5) & MyAI.desc
      Set MyAI = Nothing
    End If
  Loop
  Close
  COliste.ListIndex = 0
End Sub

Private Sub CheckControl()
  If COliste.ListIndex > 0 Or Len(COvaleur) > 0 Then
    CoAI.Enabled = False
    COlg.Enabled = False
    Label1.Enabled = False
    Label2.Enabled = False
    Option1.Enabled = False
    Option2.Enabled = False
    Check1.Enabled = False
    Check2.Enabled = False
  Else
    CoAI.Enabled = True
    COlg.Enabled = True
    Label1.Enabled = True
    Label2.Enabled = True
    Option1.Enabled = True
    Option2.Enabled = True
    Check1.Enabled = True
    Check2.Enabled = True
  End If
  If Len(CoAI) > 0 And Len(COlg) > 0 Then
    COvaleur.Enabled = True
    Label3.Enabled = True
    COvaleur.MaxLength = Val(COlg)
  Else
    COvaleur.Enabled = False
    Label3.Enabled = False
  End If
  If (Option2.Value = True And Len(COvaleur) > 0) Or (Option1.Value = True And Len(COvaleur) = Val(COlg)) Then
    BToui.Enabled = True
  Else
    BToui.Enabled = False
  End If
End Sub

Private Sub AddChecksum()
  'Calcul et ajout de la clé de contrôle EAN
  'Compute and add EAN checksum
  Dim checksum&, i%
  For i% = Len(COvaleur) To 1 Step -2
    checksum& = checksum& + Val(Mid$(COvaleur, i%, 1))
  Next
  checksum& = checksum& * 3
  For i% = Len(COvaleur) - 1 To 1 Step -2
    checksum& = checksum& + Val(Mid$(COvaleur, i%, 1))
  Next
  COvaleur = COvaleur & (10 - checksum& Mod 10) Mod 10
End Sub
 

 



 
última edición por ljma el Miercoles, 29 Diciembre 2010, 20:00; editado 1 vez 
ljma - Ver perfil del usuarioEnviar mensaje privadoVisitar sitio web del usuario 
Volver arribaPágina inferior
Mostrar mensajes anteriores:    
 
Ocultar¡Este tema fue útil?

 

Elegir valoración:                       

Media de valoración Valoración mínima Valoración máxima Número de valoraciones
0.53 0 2 15
 

Publicar nuevo tema  Responder al tema  Página 1 de 3
Ir a la página 1, 2, 3  Siguiente

Usuarios navegando en este tema: 0 registrados, 0 ocultos y 1 invitado
Usuarios registrados conectados: Ninguno


 
Lista de permisos
No puede crear mensajes
No puede responder temas
No puede editar sus mensajes
No puede borrar sus mensajes
No puede votar en encuestas
No puede adjuntar archivos
No puede descargar archivos
No puede publicar eventos en el calendario