codigo barras

Hola.
Necesito generar de unos numeros el codigo barra correspondiente en code39 o code128.
Estoy utilizando dbreport de lbmonsalve.
Me genera un codigo barra pero es ilegible para el scanner.

Conocen alguna manera de por ejemplo tener la fuente code39 en la misma carpeta del sistema y llamarla a esta desde el mismo programa? obvio sin registrar la fuente.

Hola Javier,

Echa un vistazo a este enlace con clases para generar cdigos de barras.

Javier Rodrguez
Evangelista Xojo en Espaol, Desarrollador, Consultor y Formador Xojo
Autor del libro “Programacin Multiplataforma Xojo
Autor del plug-in GuancheMOS para Xojo
Snippery para OS X: editor y gestor de fragmentos y ms!

Hey … for ean13/ean8

Create a container control with canvas … call control’Ean813’
call canvas ‘barcode’
add event ‘paint’

Paint Code paintinto(g)

Add properties strEANCode type string value a ean 13 value ( example : 4006381333672 )

Add method EAN2Bin

  Dim K As Integer
  Dim strAux As String
  Dim strExit As String
  Dim strCode As String
  
  strEANCode = Trim(strEANCode)
  strAux = strEANCode
  
  ' verifico che sia un ean13 o un ean8 in base alla lunghezza della stringa strEANCode
  If (strAux.len <> 13) And (strAux.Len <> 8) Then
    msgbox("Errore, il codice non sembra essere un codice EAN13 o EAN8")
    Return ""
  End If
  
  For K = 1 To strEANCode.len
    Select Case mid(strAux,K,1)
    Case "0","1","2","3","4","5","6","7","8","9"
      ' ok il codice non contiene caratteri non validi
    case else
      MsgBox("Errore il codice EAN contiene caratteri non ammessi")
      'Return ""
    End Select
  Next
  
  
  If (strAux.len = 13) Then
    ' verifico che sia un EAN 13
    ' per prima cosa scarto la prima cifra che  lo stato di emissione (fare riferimento ad INDICOD '
    strAux = Mid(strAux, 2)
    Select Case CInt(Left(strEANCode, 1))
    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
    strCode = "0000"
  End If
  
  '*
  '* Il codice EAN inizia con un carattere iniziale
  '*
  strExit = "000101"
  
  '*
  '* Prima met del codice
  '
  For K = 1 To Len(strAux) \\ 2
    Select Case CInt(Mid(strAux, K, 1))
    Case 0
      dim temptext as string
      if Mid(strCode, K, 1) = "0" then temptext = "0001101" else temptext = "0100111"
      strExit = strExit + temptext
    Case 1
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0011001" else temptext = "0110011"
      strExit = strExit + temptext
      
    Case 2
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0010011" else temptext = "0011011"
      strExit = strExit + temptext
      
    Case 3
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0111101" else temptext = "0100001"
      strExit = strExit + temptext
      
    Case 4
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0100011" else temptext = "0011101"
      strExit = strExit + temptext
      
    Case 5
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0110001" else temptext = "0111001"
      strExit = strExit + temptext
      
    Case 6
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0101111" else temptext = "0000101"
      strExit = strExit + temptext
      
    Case 7
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0111011" else temptext = "0010001"
      strExit = strExit + temptext
      
    Case 8
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0110111" else temptext = "0001001"
      strExit = strExit + temptext
      
    Case 9
      dim temptext as string
      If Mid(strCode, K, 1) = "0" then temptext = "0001011" else temptext = "0010111"
      strExit = strExit + temptext
      
    End Select
  Next K
  
  '*
  '* Prosegue poi con un separatore di mezzo
  '*
  strExit = strExit + "01010"
  
  '*
  '* Seconda met del codice
  '*
  For K = Len(strAux) \\ 2 + 1 To Len(strAux)
    Select Case CInt(Mid(strAux, K, 1))
    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 K
  
  
  ' Il Codice EAN finisce con un separatore finale
  
  strExit = strExit + "101000"
  
  return strExit

and now add method for paint barcode in canvas
Method paintinto

[code] Dim K As Single
Dim sngPosX As Single
Dim sngPosY As Single
dim sngX1, sngY1, sngX2, sngY2 as single
Dim sngScaleX As Single
Dim strEANBin As String
sngX1 = -1
sngX2 = -1
sngY1 = -1
sngY2 = -1

’ Converto il codice EAN nella sua rappresentazione binaria.

strEANBin = EAN2Bin(self.strEANCode)

If sngX1 = (-1) Then sngX1 = 0
If sngY1 = (-1) Then sngY1 = 0
If sngX2 = (-1) Then sngX2 = barcode.Width
If sngY2 = (-1) Then sngY2 = barcode.Height - 15

sngScaleX = floor((sngX2 - sngX1) / strEANBin.Len)

’ definisco l’altezza del barcode tenendo conto del testo
sngPosX = sngX1 ’ spigolo in alto
sngPosY = sngY2 - 14

'disegno il barcode

For K = 1 To Len(strEANBin)
If Mid(strEANBin, K, 1) = “1” Then
g.ForeColor = &c000000
g.FillRect(sngPosX, sngY1, sngScaleX, sngPosY)
End If
sngPosX = sngX1 + (K * sngScaleX)
Next K

g.DrawString(self.strEANCode,sngX1,sngPosY + 15,sngX1 - sngX2 - 5,false)
[/code]

This for draw EAN13 or EAN8 in canvas
add your code for copy drawed barcode in .jpg or other format.

Muchas Gracias

Hola,

Por favor, si alguna de las respuestas ha resuelto la consulta… márcala como tal de modo que el hilo quede “cerrado” y otros puedan ver más fácilmente que también hay solución cuando busquen por el mismo problema :wink:

Gracias,

Javier