Rutinas de Impresion de código de Barras

Jusaji
17 de Febrero del 2003
Ayuda!
Necesito las rutinas de impresión de códigos de barra EAN13

Jesus
17 de Febrero del 2003
*--------------------------------------------------------------------------
* 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