RE:Imprimir codigo de barras Bidimencional
PROCEDURE ETISOLA
SET ESCAPE ON
CLEAR
PLSWAIT(.T.,"ESPERE UN MOMENTO...")
CLEAR
***********DATOS DE LA ETIQUETA
WCODIGO1=SPACE(12)
WPRECIO1=0
********
WCODIGO2=SPACE(12)
WPRECIO2=0
********
WCODIGO3=SPACE(12)
WPRECIO3=0
***************************TOMA DE DATOS
**************RELLENO LAS ETIQUETAS
@ 0,0 SAY CENTRA("ENTRADA DE DATOS PARA ETIQUETAS INDIVIDUALES",80)
@ 3,0 SAY "TECLEE COD." GET WCODIGO1 PICT "!!!!!!!!!!!!"
@ 3,27 SAY "TECLEE COD." GET WCODIGO2 PICT "!!!!!!!!!!!!"
@ 3,54 SAY "TECLEE COD." GET WCODIGO3 PICT "!!!!!!!!!!!!"
@ 5,0 SAY "PRECIO" GET WPRECIO1 PICT "999.99"
@ 5,27 SAY "PRECIO" GET WPRECIO2 PICT "999.99"
@ 5,54 SAY "PRECIO" GET WPRECIO3 PICT "999.99"
READ
IF LASTKEY()=27
RETURN
ENDIF
****
SELECT 1
USE COLORES
SET INDEX TO COLORES
SEEK SUBSTR(WCODIGO1,9,2)
IF FOUND()
WCOLOR1=COLOR
ELSE
WCOLOR1="NO EXISTE"
ENDIF
SEEK SUBSTR(WCODIGO2,9,2)
IF FOUND()
WCOLOR2=COLOR
ELSE
WCOLOR2="NO EXISTE"
ENDIF
SEEK SUBSTR(WCODIGO3,9,2)
IF FOUND()
WCOLOR3=COLOR
ELSE
WCOLOR3="NO EXISTE"
ENDIF
SELECT 2
USE ARTICULO
SET INDEX TO CODIGO
SEEK WCODIGO1
IF FOUND()
WMODELO1=ARTICULO
ELSE
WMODELO1="NO EXISTE"
ENDIF
SEEK WCODIGO2
IF FOUND()
WMODELO2=ARTICULO
ELSE
WMODELO2="NO EXISTE"
ENDIF
SEEK WCODIGO3
IF FOUND()
WMODELO3=ARTICULO
ELSE
WMODELO3="NO EXISTE"
ENDIF
****
WTALLA1=SUBSTR(WCODIGO1,11,2)
WTALLA2=SUBSTR(WCODIGO2,11,2)
WTALLA3=SUBSTR(WCODIGO3,11,2)
***********
SET DEVICE TO PRINT
SET PRINTER TO TEXTO.TXT
@ 0,0 SAY CHR(27)+CHR(64) &&INICIALIZA IMPRESORA
X=2
N=4
DO CABEETI
********************
IF LEN(ALLTRIM(WCODIGO1)) # 0
@ N,2 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO1
ELSE
WCODIGO1="111111111141"
@ N,2 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO1
ENDIF
IF LEN(ALLTRIM(WCODIGO2)) # 0
@ N,54 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO2
ELSE
WCODIGO2="222222222242"
@ N,54 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO2
ENDIF
IF LEN(ALLTRIM(WCODIGO3)) # 0
@ N,106 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO3
ELSE
WCODIGO3="333333333343"
@ N,106 SAY CHR(27)+CHR(40)+CHR(66)+CHR(18)+CHR(1)+CHR(6)+CHR(2)+CHR(254)+CHR(45)+CHR(0)+CHR(1)+WCODIGO3
ENDIF
IF LEN(ALLTRIM(WCODIGO3)) # 0
@ N+2,0 SAY "P"
@ N+2,7 SAY WCOLOR1+" "+WMODELO1+" "+WCOLOR2+" "+WMODELO2+" "+WCOLOR3+" "+WMODELO3
@ N+3,3 SAY WW_CENTRO+" "+WW_CENTRO+" "+WW_CENTRO
ENDIF
IF LEN(ALLTRIM(WCODIGO3)) = 0 .AND. LEN(ALLTRIM(WCODIGO2)) # 0
@ N+2,0 SAY "P"
@ N+2,7 SAY WCOLOR1+" "+WMODELO1+" "+WCOLOR2+" "+WMODELO2
@ N+3,3 SAY WW_CENTRO+" "+WW_CENTRO+" "+WW_CENTRO
ENDIF
IF LEN(ALLTRIM(WCODIGO2)) = 0
@ N+2,0 SAY "P"
@ N+2,7 SAY WCOLOR1+" "+WMODELO1
@ N+3,3 SAY WW_CENTRO+" "+WW_CENTRO+" "+WW_CENTRO
ENDIF
CLOSE DATABASES
SET PRINTER TO
SET DEVICE TO SCREEN
RUN DOSP3.EXE /EURO TEXTO.TXT
RETURN
***************************
PROCEDURE CABEETI
*@ N-1,X-2 SAY "ME" &&PONE LETRA MUY PEQUE¥A
*@ N-1,X-2 SAY "M" &&PONE LETRA PEQUE¥A
@ N-1,X-2 SAY "w1" &&PONE LETRA GRANDE
IF LEN(ALLTRIM(WCODIGO1)) # 0
@ N-1,X SAY WTALLA1+" "+STR(WPRECIO1)+CHR(128)
ELSE
WTALLA1="55"
WPRECIO1=0.1
@ N-1,X SAY WTALLA1+" "+ALLTRIM(STR(WPRECIO1))+CHR(128)
ENDIF
IF LEN(ALLTRIM(WCODIGO2)) # 0
@ N-1,X+29 SAY WTALLA2+" "+STR(WPRECIO2)+CHR(128)
ELSE
WTALLA2="55"
WPRECIO2=0.1
@ N-1,X+29 SAY WTALLA2+" "+ALLTRIM(STR(WPRECIO2))+CHR(128)
ENDIF
IF LEN(ALLTRIM(WCODIGO3)) # 0
@ N-1,X+58 SAY WTALLA3+" "+STR(WPRECIO3)+CHR(128)
ELSE
WTALLA3="55"
WPRECIO3=0.1
@ N-1,X+58 SAY WTALLA3+" "+ALLTRIM(STR(WPRECIO3))+CHR(128)
ENDIF
@ N-1,X+160 SAY CHR(27)+CHR(64)
RETURN
**********************************
como ves mando el listado a un fichero txt, y luego lo imprimo con un programas que puedes conseguir en la mula o comprandolo en google buscando por bojan banko print
este programa te imprime tres etiquetas en una linea, puedes usarlo pera imprimir las que quieras.
Saludos