|
Página 1 de 3
|
Código Para Generar Códigos De Barras
| Autor |
Mensaje |
 ljma 
Programador
Registrado: Enero 2010
Mensajes: 106
Edad: 54 Ubicación: 
|
 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
|
| Descripción: |
|
Descargar |
| Nombre del archivo: |
codigos de barras.zip |
| Tamaño: |
63.13 KB |
| Descargado: |
485 veces |
|
| Descripción: |
|
Descargar |
| Nombre del archivo: |
codigos de barras.zip |
| Tamaño: |
63.13 KB |
| Descargado: |
485 veces |
|
| Descripción: |
|
Descargar |
| Nombre del archivo: |
codigos de barras.zip |
| Tamaño: |
63.13 KB |
| Descargado: |
485 veces |
última edición por ljma el Lunes, 27 Diciembre 2010, 20:19; editado 1 vez |
#1 Lunes, 27 Diciembre 2010, 20:18 |
|
 |
jsbsan
Analista Programador
Registrado: Septiembre 2009
Mensajes: 4175
Edad: 51 Ubicación: dos hermanas, sevilla
|
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
|
#2 Martes, 28 Diciembre 2010, 15:12 |
|
|
ljma
Programador
Registrado: Enero 2010
Mensajes: 106
Edad: 54 Ubicación:
|
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 |
#3 Martes, 28 Diciembre 2010, 20:36 |
|
|
jsbsan
Analista Programador
Registrado: Septiembre 2009
Mensajes: 4175
Edad: 51 Ubicación: dos hermanas, sevilla
|
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
|
#4 Martes, 28 Diciembre 2010, 21:52 |
|
|
codificador
Analista Programador
Registrado: Junio 2010
Mensajes: 420
Edad: 114 Ubicación: 
|
Re: Código Para Generar Códigos De Barras
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
|
#5 Martes, 28 Diciembre 2010, 22:09 |
|
|
tururu
Aprendiz
Registrado: Noviembre 2010
Mensajes: 61
Edad: 52
|
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
|
#6 Martes, 28 Diciembre 2010, 22:11 |
|
|
jsbsan
Analista Programador
Registrado: Septiembre 2009
Mensajes: 4175
Edad: 51 Ubicación: dos hermanas, sevilla
|
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...
|
#7 Miercoles, 29 Diciembre 2010, 08:37 |
|
|
ljma
Programador
Registrado: Enero 2010
Mensajes: 106
Edad: 54 Ubicación:
|
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
|
#8 Miercoles, 29 Diciembre 2010, 10:03 |
|
|
jsbsan
Analista Programador
Registrado: Septiembre 2009
Mensajes: 4175
Edad: 51 Ubicación: dos hermanas, sevilla
|
Re: Código Para Generar Códigos De Barras
Pues es que tu ves mas interesante:
EAN128
Saludos
|
#9 Miercoles, 29 Diciembre 2010, 12:01 |
|
|
ljma
Programador
Registrado: Enero 2010
Mensajes: 106
Edad: 54 Ubicación:
|
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).
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 |
#10 Miercoles, 29 Diciembre 2010, 19:50 |
|
|
|
|
 Temas parecidos
 Temas parecidos
|
|
Página 1 de 3
|
Usuarios navegando en este tema: 0 registrados, 0 ocultos y 1 invitado
Usuarios registrados conectados: Ninguno
|
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
Puede descargar archivos
No puede publicar eventos en el calendario
|
|
|
|
|
