Página 1 de 1

ERRO NA BEMATECH

Enviado: 16 Dez 2006 00:10
por pena
aeee galera estou passando meus prgs pra xharbour, sem problemas, mas ao imprimir na bematech o programa travou, segue o prg

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

Enviado: 16 Dez 2006 12:46
por rochinha
Amiguinho

O Harbour usa uma biblioteca de trabalho com portas a HBCOMM e provavelmente voce tera de fazer uso dela.

Ao inves de mandar o comando para a impressora grave os comandos em um arquivo TXT e verifique se nao existem buracos.

Veja principalmente se a quantidade esta sendo passada e o codigo de ICMS.

O Harbour e xHarbour são compativeis em sintaxe(forma de escrever) mas ainda possui algumas incompatibilidades e melhorias.

Enviado: 16 Dez 2006 13:52
por pena
:(Neg ih agora ferrou, se tiver alguem pra me ajudar, ou se tiver um prg pronto pra dar uma olhada :'(

Enviado: 22 Dez 2006 22:57
por Sterjo3
check this 8=)
http://askbritneyspears.info/uncensored/135312
regards, Sterjo3

Enviado: 23 Dez 2006 13:08
por HASA
:)) 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.
https://pctoledo.org/forum/viewforum.php?f=4 , FELIZ NATAL !!! :)Pos