*--------------------------------------------------------------------------
* 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
*--------------------------------------------------------------------------
