** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - codigo barra 128-C
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradocodigo barra 128-C
 Responder Responder
Autor
Mensaje
  Tema Buscar Tema Buscar  Opciones del Tema Opciones del Tema
carlosbelmonte Ver desplegable
Asiduo
Asiduo
Avatar

Unido: 06/Octubre/2010
Localización: España
Estado: Sin conexión
Puntos: 466 		Enlace directo a este mensaje Tema: codigo barra 128-C
    Enviado: 01/Febrero/2020 a las 00:14		 


Hola a todos,
quisiera pasar este codigo de FoxPro para generar codigo de barras 128C a Access (vb), alguién sabe hacerlo ?

FUNCTION _StrTo128C(tcString)
  LOCAL lcStart, lcStop, lcRet, lcCheck, lcCar, ;
    lnLong, lnI, lnCheckSum, lnAsc
  lcStart = CHR(105 + 32)
  lcStop = CHR(106 + 32)
  lnCheckSum = ASC(lcStart) - 32
  lcRet = ALLTRIM(tcString)
  lnLong = LEN(lcRet)
  *--- La longitud debe ser par
  IF MOD(lnLong,2) # 0
    lcRet = '0' + lcRet
    lnLong = LEN(lcRet)
  ENDIF
  *--- Convierto los pares a caracteres
  lcCar = ''
  FOR lnI = 1 TO lnLong STEP 2
    lcCar = lcCar + CHR(VAL(SUBS(lcRet,lnI,2)) + 32)
  ENDFOR
  lcRet = lcCar
  lnLong = LEN(lcRet)
  FOR lnI = 1 TO lnLong
    lnAsc = ASC(SUBS(lcRet,lnI,1)) - 32
    lnCheckSum = lnCheckSum + (lnAsc * lnI)
  ENDFOR
  lcCheck = CHR(MOD(lnCheckSum,103) + 32)
  lcRet = lcStart + lcRet + lcCheck + lcStop
  *--- Esto es para cambiar los espacios y caracteres invalidos
  lcRet = STRTRAN(lcRet,CHR(32),CHR(232))
  lcRet = STRTRAN(lcRet,CHR(127),CHR(192))
  lcRet = STRTRAN(lcRet,CHR(128),CHR(193))
  RETURN lcRet
ENDFUNC
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14738 		Enlace directo a este mensaje Enviado: 01/Febrero/2020 a las 08:56
No tengo ni la mas remota idea del lenguaje de FoxPro pero no me ha parecido difícil de entender lo que hace y como lo hace.

¿Qué has hecho tu y dónde te has encallado?
Xavi, un minyó de Terrassa

Mi web
Arriba
carlosbelmonte Ver desplegable
Asiduo
Asiduo
Avatar

Unido: 06/Octubre/2010
Localización: España
Estado: Sin conexión
Puntos: 466 		Enlace directo a este mensaje Enviado: 01/Febrero/2020 a las 10:33
Aqui por ejemplo :
 IF MOD(lnLong,2) # 0
    lcRet = '0' + lcRet
    lnLong = LEN(lcRet)
ENDIF
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14738 		Enlace directo a este mensaje Enviado: 01/Febrero/2020 a las 11:00
La linea anterior dice: "la longitud debe ser par". En base a ese comentario y solo leyendo y buscando en Google, se ve bastante claro lo que hace las líneas de codigo

Si el residuo de dividir la longitud entre 2 es distinto de cero, añadir un cero delante y recalcular la variable que contiene la longitud.

- La función Mod tambien existe en VBA
- Una simple búsqueda me dice que, en FoxPro, el simbolo # significa "no igual". 
- Utilizar + o & para concatenar está aceptado
- La función Len también existe en VBA
Xavi, un minyó de Terrassa

Mi web
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4830 		Enlace directo a este mensaje Enviado: 03/Febrero/2020 a las 21:39
Prueba con el siguiente código ,........ Ojo No lo he probado ,.......

Public Function StrTo128C(tcString) As Variant


    Dim lcStart, lcStop, lcRet, lcCheck, lcCar, lnLong, lnI, lnCheckSum, lnAsc

    lcStart = Chr(105 + 32)
    lcStop = Chr(106 + 32)
    lnCheckSum = Asc(lcStart) - 32
    lcRet = Trim(tcString)
    lnLong = Len(lcRet)

    '*--- La longitud debe ser par
    If lnLong Mod 2 <> 0 Then
        lcRet = "0" & lcRet
        lnLong = Len(lcRet)
    End If

    '*--- Convierto los pares a caracteres
    lcCar = "''"
    For lnI = 1 To lnLong Step 2
        lcCar = lcCar + Chr(Val(Mid(lcRet, lnI, 2)) + 32)
    Next

    lcRet = lcCar
    lnLong = Len(lcRet)

    For lnI = 1 To lnLong
        lnAsc = Asc(Mid(lcRet, lnI, 1)) - 32
        lnCheckSum = lnCheckSum + (lnAsc * lnI)
    Next



    lcCheck = Chr((lnCheckSum Mod 103) + 32)


    lcRet = lcStart + lcRet + lcCheck + lcStop
    '*--- Esto es para cambiar los espacios y caracteres invalidos
    lcRet = Replace(lcRet, Chr(32), Chr(232))
    lcRet = Replace(lcRet, Chr(127), Chr(192))
    lcRet = Replace(lcRet, Chr(128), Chr(193))


    MsgBox lcRet
    StrTo128C = lcRet


End Function
https://www.accessdemo.info
Arriba
carlosbelmonte Ver desplegable
Asiduo
Asiduo
Avatar

Unido: 06/Octubre/2010
Localización: España
Estado: Sin conexión
Puntos: 466 		Enlace directo a este mensaje Enviado: 19/Febrero/2020 a las 19:42
hola, voy a probarlo , y este codigo que es el tipo B, podrias pasarlo  a VBA  por favor ?
Function StrTo128B(tcString)
On Error GoTo Fin:
Dim i, lcStart, lcStop, lcRet, lcCheck, lnLong, lnI, lnCheckSum, lnAsc, ln1
lcStart = Chr(104 + 32)
lcStop = Chr(106 + 32)
lnCheckSum = Asc(lcStart) - 32
lcRet = tcString
lnLong = Len(lcRet)
For lnI = 1 To lnLong
lnAsc = Asc(Mid(lcRet, lnI, 1)) - 32
If Not (lnAsc >= 0 And lnAsc <= 99) Then
Mid(lcRet, ln1, 1) = Chr(32) 'Si el Ascii no está entre 0 y 64 lo reemplaza por Chr(32)
lnAsc = Asc(InStr(lcRet, lnI, 1)) - 32
End If
lnCheckSum = lnCheckSum + (lnAsc * lnI)
Next
lcCheck = Chr(lnCheckSum Mod 103 + 32)
lcRet = lcStart + lcRet + lcCheck + lcStop
'*--- Esto es para cambiar los espacios y caracteres invalidos
'i = 1
'Do While i <> 0
'i = InStr(lcRet, Chr(32))
'If i > 0 Then
'Mid(lcRet, i, 1) = Chr(232)
'End If
'Loop
'i = 1
'Do While i <> 0
'i = InStr(lcRet, Chr(127))
'If i > 0 Then
'Mid(lcRet, i, 1) = Chr(192)
'End If
'Loop
StrTo128B = lcRet
Fin:
'Exit Function
End Function
Arriba
xavi Ver desplegable
Administrador
Administrador
Avatar
Terrassa-BCN

Unido: 10/Mayo/2005
Localización: Catalunya ||||
Estado: Sin conexión
Puntos: 14738 		Enlace directo a este mensaje Enviado: 19/Febrero/2020 a las 21:54
Hola Carlos,

Lo que escribo a continuación es a título personal.

Cuando iniciaste el hilo se te dijo que plantearas dudas concretas. Tu primera respuesta y mi contrarespuesta demuestran las pocas ganas de buscar información. Después viene Javier y te regala un código.
16 días después vuelves a aparecer en el hilo para, sin agradecer nada ni decir si funcionó o no, pedir que te pasen otro código.

Llevas casi 10 años en el foro. Has puesto más de 400 mensajes pero en ninguno de ellos has aportado nada a la comunidad. Solo has venido aquí a pedir que te hagan el trabajo.

Dado que yo hago esto de forma desinteresada, soy libre de decidir a quien le regalo mi tiempo y a quien no. Los usuarios que demuestran interés, que hacen pruebas, que devuelven conocimiento, que se interesan... eso si, a esos les dedicaré (en la medida de mis posibilidades) algo de tiempo. A los que no aportan y solo piden, a esos no. Repito: es mi opinión personal. Mis compañeros administradores y el resto del foro no tienen que compartir necesariamente mi forma de pensar y son libres de responder.

Si lo necesitas, este foro tiene un apartado dónde los profesionales se anuncian y dónde puede colgar demandas de trabajo.

Un saludo
Xavi, un minyó de Terrassa

Mi web
Arriba
javier.mil Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 10/Agosto/2005
Localización: España
Estado: Sin conexión
Puntos: 4830 		Enlace directo a este mensaje Enviado: 19/Febrero/2020 a las 22:15
Estoy totalmente de acuerdo con Xavi , lo mínimo es ser agradecido,....... aparte de decir si el código te funciono o No funciono,...... antes de pedir otro código nuevo
https://www.accessdemo.info
Arriba
carlosbelmonte Ver desplegable
Asiduo
Asiduo
Avatar

Unido: 06/Octubre/2010
Localización: España
Estado: Sin conexión
Puntos: 466 		Enlace directo a este mensaje Enviado: 05/Marzo/2020 a las 13:57
Perdón por la tardanza, pero estuve hospitalizado y no puede ni contestar después, por supuesto estoy muy agradecido. Me sirvió totalmente y pueden cerrar el hilo.
Ahora os pongo un código que encontré para los codigos de barra 128 que funciona perfectamente :
Public Function Barcode_128(Ctrl As Control, rpt As Report)
    'On Error GoTo ErrorTrap_Barcode_128

    'Code 128B has 5 main parts to it. The first part is a start character(211214), followed by DataCharcters. The Data
    'Characters are followed by a check(or Checksum) Character, and that is followed by a stop Character(2331112)
    'The last part of Code 128B is the two quiet sections at the front and back of the barcode. These are 10 dimensions
    'Long(I am thinking that is 11 modules long). Each character is 11 modules long, except the stop character which is
    '13 modules long

    Dim CharNumber As Variant, CharData As Variant, CharBarData As Variant, Nratio As Variant, Nbar As Variant
    Dim barcodestr As String, Barcode As String, Barchar As String, Barcolor As Long, Parts As Integer, J As Integer
    Dim tsum As Integer, lop As Integer, s As Integer, checksum As Integer, P As Integer, barwidth As Integer
    Dim boxh As Single, boxw As Single, boxx As Single, boxy As Single, Pix As Single, Nextbar As Single
    Const White = 16777215: Const Black = 0

    'This is the Raw data that I threw into an arrays
    CharNumber = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16,", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29,", "30", "31", "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85", "86", "87", "88", "89", "90", "91", "92", "93", "94", "95", "96", "97", "98", "99", "100", "101", "102", "103", "104", "105", "106")
    CharData = Array("SP", "!", Chr(34), "#", "$", "%", "&", "'", "(", ")", "*", "+", ",", "-", ".", "/", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ":", ";", "<", "=", ">", "?", "@", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "[", "\", "]", "^", "_", "`", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "I", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "{", "|", "}", "~", "DEL", "FNC 3", "FNC 2", "SHIFT", "CODE C", "FNC 4", "CODE A", "FNC 1", "Start A", "Start B", "Start C", "Stop")
    CharBarData = Array("212222", "222122", "222221", "121223", "121322", "131222", "122213", "122312", "132212", "221213", "221312", "231212", "112232", "122132", "122231", "113222", "123122", "123221", "223211", "221132", "221231", "213212", "223112", "312131", "311222", "321122", "321221", "312212", "322112", "322211", "212123", "212321", "232121", "111323", "131123", "131321", "112313", "132113", "132311", "211313", "231113", "231311", "112133", "112331", "132131", "113123", "113321", "133121", "313121", "211331", "231131", "213113", "213311", "213131", "311123", "311321", "331121", "312113", "312311", "332111", "314111", "221411", "431111", "111224", "111422", "121124", "121421", "141122", "141221", "112214", "112412", "122114", "122411", "142112", "142211", "241211", "221114", "413111", "241112", "134111", "111242", "121142", "121241", "114212", "124112", "124211", "411212", "421112", "421211", "212141", _
                        "214121", "412121", "111143", "111341", "131141", "114113", "114311", "411113", "411311", "113141", "114131", "311141", "411131", "211412", "211214", "211232", "2331112")

    barcodestr = "211214" 'Add the Startcode for Start B (characterset B) to the barcode string
    tsum = 104                      'And this is the value for that startcode which will be added with the other character values to find the checksum character
    boxx = Ctrl.Left: boxy = Ctrl.Top: boxw = Ctrl.Width: boxh = Ctrl.Height    'Get control size and location properties.

    Barcode = Ctrl                                                          'Set handle on control.

    Nratio = Array("0", "15", "30", "45", "60")           'Set up the array for the different bar width ratios
    Parts = ((11 * (Len(Barcode))) + 35) * Nratio(1)  'This is the formula for the width of the barcode
    Pix = (boxw / Parts)                                                  'Here I find out exactly how many Pixels a bar will be
    Nbar = Array((Nratio(0) * Pix), (Nratio(1) * Pix), (Nratio(2) * Pix), (Nratio(3) * Pix), (Nratio(4) * Pix)) 'Set up the array to handle the pixels for each type of bar

    'Loop through all bardata to count the sum for all characters and add barcode charcter strings the to the barcode string
    For lop = 1 To Len(Barcode)
        Barchar = Mid(Barcode, lop, 1)
        If Barchar = " " Then Barchar = "SP"
        For s = 0 To UBound(CharData)
            If Barchar = CharData(s) Then
                barcodestr = barcodestr & CharBarData(s) 'This is where I added the character strings to each other to make one long string of 1's, 2's, 3's, & 4's
                tsum = tsum + (CLng(CharNumber(s)) * lop) 'Here every barcode character's number value is multiplied by its position in the line and added to tsum
                'The actual formula for find the the  Checksum  is "(104 + (1 * CharcterNumber) + (2 * CharcterNumber) + ...)/103" You would Use the Remainder as
                'The Checksum Character. In the case of "BarCode 1" the formula would look
                'like "(104+(1*34)+(2*65)+(3*82)+(4*35)+(5*79)+(6*68)+(7*69)+(8*0)+(9*17))/103=20 with Remainder of 33" Therefore the checksum would equal 33
                Exit For
            End If
        Next s
    Next lop

    checksum = tsum - (Int(tsum / 103) * 103)                                             'Here I use the the totat sum (tsum) to find the checksum
    barcodestr = barcodestr & CharBarData(checksum) & "2331112" 'Here I add the checksum then the stop character into the barcode string

    'lets do some initialization
    Barcolor = Black
    Nextbar = boxx + 11     'I added the 20 for the whitespace (or quiet space) at the beginning of the barcode

    'Draw the Barcode
    For J = 1 To Len(barcodestr)
        Barchar = Mid(barcodestr, J, 1)   'Reuse variable barchar to store the character to be drawn
        barwidth = CInt(Barchar)              'Change the barcode charcter into an integer so I can use in the array part of the next line
        rpt.Line (Nextbar, boxy)-Step(Nbar(barwidth), boxh), Barcolor, BF  'Draw the line
        Nextbar = Nextbar + Nbar(barwidth)                                                      'Calculate the next starting point
        If Barcolor = White Then Barcolor = Black Else Barcolor = White      'Swap line colors
    Next J

Exit_Barcode_128:
    Exit Function

ErrorTrap_Barcode_128:
    MsgBox Error$

    Resume Exit_Barcode_128
End Function



Después en un informe poneis un campo que por ejemplo se llame MiCodigoBarras128  y en el evento al Dar Formato :
 Dim Result As Boolean
    Result = Barcode_128(Me.MiCodigoBarras128, Me)

Un saludo a todos
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable