Código: Selecionar todos
FUNC EMIT_BEMATECH
LOCAL COD,DESCRICAO,UNIT, telax:=savescreen(00,00,24,79),OBS:="",OBS1:="",;
OBS2:="",OBS3:="",OBS4:="",OBS5:="",OBS6:="",OBS7:="",OBS8:="",OBS9:="",;
A_PAGAR:=0
PRIV GSAIR:=.F.
MENSAGEM(00,00,00,00,"","Aguarde Imprimindo Cupom N£mero.: "+STR(MOVIMENT->NUMERO,6)+"|","",.F.,SOM,.F.,.T.)
VTOTAL:=0
IMPCUP(chr(27)+chr(251)+"00|"+chr(27))
SELE MOVIMENT
SET ORDER TO 1
SEEK M->SERIE+STR(M->NUMERO,6)
SELE ITENS
SET ORDER TO 1
SEEK MOVIMENT->SERIE+STR(MOVIMENT->NUMERO,6)
DO WHILE ! EOF() .AND. ITENS->SERIE=MOVIMENT->SERIE .AND. ITENS->NUMERO=MOVIMENT->NUMERO
COD=STR(ITENS->PRODUTO,13)
SELE PRODUTOS
SET ORDER TO 1
SEEK ITENS->PRODUTO
IF EMPTY(ITENS->COMPLEMENT)
DESCRICAO=LEFT(PRODUTOS->PRODUTO,29)
ELSE
DESCRICAO=LEFT(ITENS->COMPLEMENT,29)
ENDI
UNIT=STRZERO(ITENS->UNITARIO,8,3)
UNIT="00"+SUBS(UNIT,1,4)+SUBS(UNIT,6,2)
QUANT=STRZERO(ITENS->QUANTIDADE,8,3)
QUANT=SUBS(QUANT,1,4)+SUBS(QUANT,6,3) &&"0" +VAL4
ALIQ:=""
IF ITENS->TRIICM$"3060"
M->ALIQ:="FF"
ELSEIF ITENS->TRIICM$"405070"
M->ALIQ:="II"
ELSE
IF ITENS->TRIICM="2"
ICM_R:=ROUND((ITENS->ICM*ITENS->BASICM)/100,2)
ELSE
ICM_R:=ITENS->ICM
ENDIF
IF ICM_R=18
M->ALIQ:="01"
ELSEIF ICM_R=7
M->ALIQ:="02"
ELSEIF ICM_R=26
M->ALIQ:="03"
ELSEIF ICM_R=17
M->ALIQ:="04"
ELSEIF ICM_R=25
M->ALIQ:="05"
ENDIF
ENDIF
M->ALIQ:=IF(EMPTY(M->ALIQ),"II",M->ALIQ)
DESCONTO=STRZERO(ITENS->DESCONTO)
DESCONTO=SUBS(DESCONTO,1,2)+SUBS(DESCONTO,4,2)
IMPCUP(chr(27)+chr(251)+"09|"+COD+"|"+DESCRICAO+"|"+M->ALIQ+"|"+QUANT+"|"+UNIT+"|"+DESCONTO+"|"+CHR(27))
SELE ITENS
SET ORDER TO 1
VTOTAL=VTOTAL+(QUANTIDADE*UNITARIO)
SKIP
ENDDO
OBS=""
IF MOVIMENT->CONDICAO<>999
SELE DUPLICAT
SET ORDE TO 4
SEEK "R"+SUBS(MOVIMENT->SERIE,4,2)+SUBS(MOVIMENT->SERIE,1,3)+STR(M->NUMERO,06)
IF FOUND()
VTOTAL=0
*"00000000000000"
OBS:=" Venda a Prazo - Vencimento: "+DTOC(DUPLICAT->VENC)+SPACE(2)
ENDIF
ENDIF
IF MOVIMENT->CLIENTE=999999
SELE OMCLIENT
SET ORDER TO 1
SEEK MOVIMENT->SERIE+STR(MOVIMENT->NUMERO,06)
OBS:="Cliente : "+TRAN(MOVIMENT->CLIENTE,"@E 999999")+"-"+SUBSTR(OMCLIENT->NOME,1,31)+IF(!EMPTY(OMCLIENT->ENDERECO),"Endereco: "+LEFT(OMCLIENT->ENDERECO,38),SPACE(48))
OBS1:=IF(!EMPTY(OMCLIENT->CGC),"CGC : "+OMCLIENT->CGC+SPACE(24),"")+IF(!EMPTY(OMCLIENT->INSCRICAO),"Inscricao : "+OMCLIENT->INSCRICAO+SPACE(16),"")
ELSE
SELE CLIENTES
SET ORDER TO 1
SEEK MOVIMENT->CLIENTE
OBS1:="Cliente:"+TRAN(MOVIMENT->CLIENTE,"999999")+"-"+SUBS(CLIENTES->CLIENTE,1,33)+;
"End....:"+LEFT(CLIENTES->ENDERECO,40)+;
"Cidade.:"+LEFT(CLIENTES->CIDADE,25)+" Cep:"+CLIENTES->CEP+;
"Cgc/Cpf:"+IF(!EMPTY(SUBS(CLIENTES->CGC,1,1)),TRAN(CLIENTES->CGC,"99.999.999/9999-99"),;
TRAN(CLIENTES->CPF,"@R 999.999.999-99")+SPACE(4))+"I.E.:"+LEFT(CLIENTES->INSCRICAO,17)
ENDI
OBS2=""
IF MOVIMENT->TRANSPORTE<>999999
SELE TRANSP
SEEK MOVIMENT->TRANSPORTE
OBS2="Transp.:"+TRAN(MOVIMENT->TRANSPORTE,"999999")+"-"+SUBSTR(TRANSP->TRANSP,1,17)+" Placa: "+TRANSP->PLACA
ELSE
OBS2="Transp.:"+"999999"+"-"+SUBSTR(M->NOMETRA,1,17)+" Placa: "+M->PLACA
ENDI
OBS3=""
SELE VENDEDOR
SET ORDER TO 1
SEEK MOVIMENT->VENDEDOR
OBS3:="Vend...:"+TRAN(MOVIMENT->VENDEDOR,"999999")+"-"+LEFT(VENDEDOR->VENDEDOR,12)+" Controle: "+SUBS(MOVIMENT->SERIE,1,3)+" "+TRAN(MOVIMENT->NUMERO,"@E 999999")
VT=VTOTAL
VTOTAL=strzero(VTOTAL,15,2)
Vtotal=SUBS(vtotal,1,12)+SUBS(vtotal,14,2) &&"0" +VAL4
M->VALDESC=strzero(M->VALDESC,15,2)
M->VALDESC=SUBS(M->VALDESC,1,12)+SUBS(M->VALDESC,14,2) &&"0" +VAL4
OBX:=OBS+OBS1+OBS2+OBS3
IMPCUP(chr(27)+chr(251)+"10|XXXX|"+VTOTAL+"|d|"+M->VALDESC+"|"+OBX+" "+CHR(13)+"|"+chr(27))
restscreen(00,00,24,79,telax)
*********************************
Function IMPCUP
*Envia para a impressora os dados
*********************************
Parameters BUFFER
*RETURN .T.
save screen to rd
restore screen from rd
IF ("PARAM"+STRZERO(VAL(MAQ),2))->PORTA="2"
FP=FOpen("COM2",2) //Abre a porta COM2//
ELSE
FP=FOpen("COM1",2) //Abre a porta COM2//
ENDI
IF ferror() != 0
JANELA(07,26,21,77)
COR("FUNDO DA TELA")
@ 08,27 Say "Problemas de comunica‡Æo."
COR("CARACTERES AVULSOS")
@ 13,28 Say "Este tipo de problema geralmente por falha no"
@ 14,28 Say "transporte dos dados, verifique se o cabo"
@ 15,23 Say "micro-impressora est devidamente conectado"
@ 17,23 Say "Pressione uma tecla para retornar."
Inkey(0)
Return nil
ENDIF
*FREAD(FP,@BUFFER,len(BUFFER))
FWrite(FP,@BUFFER,len(BUFFER))
*IF FWRITE()=0
*ACHO:={"Repetir","Sair"}
*ncho:=alert("Impressora Desligada",acho)
*if ncho=2
* GSAIR:=.T.
* retu
*endi
*endi
ACK = SPACE (1)
ST1 = SPACE (1)
ST2 = SPACE (1)
BUFTOT = ""
BUFRX = SPACE(1)
FRead (FP, @BUFRX, 1) //Leitura de ACK//
ACK = TRANSFORM(ASC(BUFRX), "99")
FRead (FP, @BUFRX, 1)
ST1 = TRANSFORM(ASC(BUFRX), "99") //Leitura de ST1//
FRead (FP, @BUFRX, 1)
ST2 = TRANSFORM(ASC(BUFRX), "99") //Leitura de ST2//
* IF ST1=4
* MENSAGEM(00,00,00,00,"","Aguarde Imprimindo Cupom|","",.F.,SOM,.F.,.T.)
* MENSAGEM(00,00,00,00," Aten‡„o ","Impressora Desligada","",.F.,SOM,.F.,.T.)
* ENDIF
FClose(FP)
Return nil
) OLÁ COMPANHEIRO, BOAS FESTAS, COMO JÁ POSTOU O JANIO EM OUTRO TOPICO PARA VC ACESSE O NEWS DO XHARBOUR, LÁ TEM VARIAS DICAS SOBRE ESSE CASO DA BEMATECH OK.