• Jueves 28 de Marzo de 2024, 17:47

Mostrar Mensajes

Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.


Mensajes - albertoa0255

Páginas: [1]
1
Visual FoxPro / Re:Códigos De Barra
« en: Miércoles 10 de Agosto de 2016, 08:33 »
*--------------------------------------------------------------------------
* PROGRAMA: CodBar.prg
* FECHA   : 2000/04/25
* AUTOR   : Luis María Guayán
* E-MAIL  : luis.guayan@vicentetrapani.com
*--------------------------------------------------------------------------
* Estas funciones convierten una cadena de caracteres a los siguientes
* formatos:
*   Codigo 39    : _StrTo39()
*   Codigo 128-A : _StrTo128A()
*   Codigo 128-B : _StrTo128B()
*   Codigo 128-C : _StrTo128C()
*   Codigo EAN-13: _StrToEan13()
*   Codigo EAN-8 : _StrToEan8()
*--------------------------------------------------------------------------
* FUNCTION _StrTo39(tcString)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type Barcode 3 of 9
* USO: _StrTo39("Codigo 39")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
FUNCTION _StrTo39(tcString)
   lcRet = "*"+tcString+"*"
   RETURN lcRet
ENDFUNC

*--------------------------------------------------------------------------
* FUNCTION _StrTo128A(tcString)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type Barcode 128 A
* Caracteres numéricos y alfabeticos (solo mayúsculas)
* Si un caracter es no válido lo remplaza por espacio
* USO: _StrTo128A("CODIGO 128")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
FUNCTION _StrTo128A(tcString)

   LOCAL lcStart, lcStop, lcRet, lcCheck, ;
      lnLong, lnI, lnCheckSum, lnAsc

   lcStart = CHR(103 + 32)
   lcStop = CHR(106 + 32)
   lnCheckSum = ASC(lcStart) - 32

   lcRet = tcString
   lnLong = LEN(lcRet)
   FOR lnI = 1 TO lnLong
      lnAsc = ASC(SUBS(lcRet,lnI,1)) - 32
      IF NOT BETWEEN(lnAsc, 0, 64)
         lcRet = STUFF(lcRet,lnI,1,CHR(32))
         lnAsc = ASC(SUBS(lcRet,lnI,1)) - 32
      ENDIF
      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

*--------------------------------------------------------------------------
* FUNCTION _StrTo128B(tcString)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type Barcode 128 B
* Caracteres numéricos y alfabeticos (mayúsculas y minúsculas)
* Si un caracter es no válido lo remplaza por espacio
* USO: _StrTo128B("Codigo 128")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
FUNCTION _StrTo128B(tcString)

   LOCAL lcStart, lcStop, lcRet, lcCheck, ;
      lnLong, lnI, lnCheckSum, lnAsc

   lcStart = CHR(104 + 32)
   lcStop = CHR(106 + 32)
   lnCheckSum = ASC(lcStart) - 32

   lcRet = tcString
   lnLong = LEN(lcRet)
   FOR lnI = 1 TO lnLong
      lnAsc = ASC(SUBS(lcRet,lnI,1)) - 32
      IF NOT BETWEEN(lnAsc, 0, 99)
         lcRet = STUFF(lcRet,lnI,1,CHR(32))
         lnAsc = ASC(SUBS(lcRet,lnI,1)) - 32
      ENDIF
      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

*--------------------------------------------------------------------------
* FUNCTION _StrTo128C(tcString)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type Barcode 128 C
* Solo caracteres numéricos
* USO: _StrTo128C("01234567")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
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

*--------------------------------------------------------------------------
* FUNCTION _StrToEan13(tcString, .T.)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type EAN-13
* PARAMETROS:
*   tcString: Caracter de 12 dígitos (0..9)
*   tlCheckD: .T. Solo genera el dígito de control
*             .F. Genera dígito y caracteres a imprimir
* USO: _StrToEan13("123456789012")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
FUNCTION _StrToEan13(tcString, tlCheckD)

   LOCAL lcLat, lcMed, lcRet, lcJuego, ;
      lcIni, lcResto, lcCod, ;
      lnI, lnCheckSum, lnAux, laJuego(10), lnPri

   lcRet=ALLTRIM(tcString)

   IF LEN(lcRet) # 12
      *--- Error en parámetro
      *--- debe tener un len = 12
      RETURN ""
   ENDIF

   *--- Genero dígito de control
   lnCheckSum=0
   FOR lnI = 1 TO 12
      IF MOD(lnI,2) = 0
         lnCheckSum = lnCheckSum + VAL(SUBS(lcRet,lnI,1)) * 3
      ELSE
         lnCheckSum = lnCheckSum + VAL(SUBS(lcRet,lnI,1)) * 1
      ENDIF
   ENDFOR
   lnAux = MOD(lnCheckSum,10)
   lcRet = lcRet + ALLTRIM(STR(IIF(lnAux = 0, 0, 10-lnAux)))

   IF tlCheckD
      *--- Si solo genero dígito de control
      RETURN lcRet
   ENDIF

   *--- Para imprimir con fuente True Type EAN13
   *--- 1er. dígito (lnPri)
   lnPri = VAL(LEFT(lcRet, 1))
   *--- Tabla de Juegos de Caracteres
   *--- según "lnPri" (¡NO CAMBIAR!)
   laJuego(1) = "AAAAAACCCCCC"   && 0
   laJuego(2) = "AABABBCCCCCC"   && 1
   laJuego(3) = "AABBABCCCCCC"   && 2
   laJuego(4) = "AABBBACCCCCC"   && 3
   laJuego(5) = "ABAABBCCCCCC"   && 4
   laJuego(6) = "ABBAABCCCCCC"   && 5
   laJuego(7) = "ABBBAACCCCCC"   && 6
   laJuego(8) = "ABABABCCCCCC"   && 7
   laJuego(9) = "ABABBACCCCCC"   && 8
   laJuego(10) = "ABBABACCCCCC"   && 9

   *--- Caracter inicial (fuera del código)
   lcIni = CHR(lnPri + 35)
   *--- Caracteres lateral y central
   lcLat = CHR(33)
   lcMed = CHR(45)

   *--- Resto de los caracteres
   lcResto = SUBS(lcRet, 2, 12)
   FOR lnI = 1 TO 12
      lcJuego = SUBS(laJuego(lnPri + 1), lnI, 1)
      DO CASE
         CASE lcJuego = "A"
            lcResto = STUFF(lcResto, lnI, 1, CHR(VAL(SUBS(lcResto, lnI, 1))+48))
         CASE lcJuego = "B"
            lcResto = STUFF(lcResto, lnI, 1, CHR(VAL(SUBS(lcResto, lnI, 1))+65))
         CASE lcJuego = "C"
            lcResto = STUFF(lcResto, lnI, 1, CHR(VAL(SUBS(lcResto, lnI, 1))+97))
      ENDCASE
   ENDFOR

   *--- Armo código
   lcCod = lcIni + lcLat + SUBS(lcResto,1,6) + lcMed + SUBS(lcResto,7,6) + lcLat
   RETURN lcCod
ENDFUNC


*--------------------------------------------------------------------------
* FUNCTION _StrToEan8(tcString, .T.)
*--------------------------------------------------------------------------
* Convierte un string para ser impreso con
* fuente True Type EAN-8
* PARAMETROS:
*   tcString: Caracter de 7 dígitos (0..9)
*   tlCheckD: .T. Solo genera el dígito de control
*             .F. Genera dígito y caracteres a imprimir
* USO: _StrToEan8("1234567")
* RETORNA: Caracter
* AUTOR: Luis María Guayán
*--------------------------------------------------------------------------
FUNCTION _StrToEan8(tcString, tlCheckD)

   LOCAL lcLat, lcMed, lcRet, ;
      lcIni, lcCod, ;
      lnI, lnCheckSum, lnAux

   lcRet=ALLTRIM(tcString)

   IF LEN(lcRet) # 7
      *--- Error en parámetro
      *--- debe tener un len = 7
      RETURN ""
   ENDIF

   *--- Genero dígito de control
   lnCheckSum=0
   FOR lnI = 1 TO 7
      IF MOD(lnI,2) = 0
         lnCheckSum = lnCheckSum + VAL(SUBS(lcRet,lnI,1)) * 3
      ELSE
         lnCheckSum = lnCheckSum + VAL(SUBS(lcRet,lnI,1)) * 1
      ENDIF
   ENDFOR
   lnAux = MOD(lnCheckSum,10)
   lcRet = lcRet + ALLTRIM(STR(IIF(lnAux = 0, 0, 10-lnAux)))

   IF tlCheckD
      *--- Si solo genero dígito de control
      RETURN lcRet
   ENDIF

   *--- Para imprimir con fuente True Type EAN8
   *--- Caracteres lateral y central
   lcLat = CHR(33)
   lcMed = CHR(45)

   *--- Caracteres
   FOR lnI = 1 TO 8
      IF lnI <= 4
         lcRet = STUFF(lcRet, lnI, 1, CHR(VAL(SUBS(lcRet, lnI, 1))+48))
      ELSE
         lcRet = STUFF(lcRet, lnI, 1, CHR(VAL(SUBS(lcRet, lnI, 1))+97))
      ENDIF
   ENDFOR

   *--- Armo código
   lcCod = lcLat + SUBS(lcRet,1,4) + lcMed + SUBS(lcRet,5,4) + lcLat
   RETURN lcCod
ENDFUNC

*--------------------------------------------------------------------------
* FIN CodBar.prg
*--------------------------------------------------------------------------

Páginas: [1]