PC Toledo

Código: Selecionar todos

// /////////////////////////////////////////////////////////////
// 02/07/2007                                                 //
// ORIGINAL ESCRITO POR FLADIMIR ( PCTOLEDO )                 //
// COMPILADO EM XHARBOUR 0.99.70 ( SIMPLEX ) + BORLAND 5.5.1  //
// BRMAKE 2.05                                                //
// /////////////////////////////////////////////////////////////

#include "common.ch" 
#include "inkey.ch" 

FUNCTION MAIN() 

REQUEST DBFCDX 
RDDSETDEFAULT('DBFCDX') 

CLS 

USE PLANILHA alias FILETEMP new exclusive 
zap 
APPEND BLANK 
FILETEMP->( DBGOTOP() )
DBSELECTAR("FILETEMP")

PRIVATE bCamp[5],bNomes[5],bPict[5],total:=0 

bCamp[1]  := "codprod" 
bCamp[2]  := "left(descricao,25)" 
bCamp[3]  := "quant" 
bCamp[4]  := "vendaprod" 
bCamp[5]  := "total" 

bNomes[1]  := "Codigo" 
bNomes[2]  := "   Descricao" 
bNomes[3]  := "   Quant" 
bNomes[4]  := "Vlr Venda" 
bNomes[5]  := "Total Ger" 

bPict[1] := "@!" 
bPict[2] := "@!" 
bPict[3] := "@E 9,999,999" 
bPict[4] := "@E 9999.99" 
bPict[5] := "@E 99999.99" 

@20,20 SAY "Pressione ENTER e Digite o Codigo do Produto" 
DBEDIT(05,02,15,76,bCamp,"Analise",bpict,bNomes,"Ä","|","")

RETURN 

********************** 
FUNCTION Analise(modo) 

LOCAL codigo:=SPACE(6),GETLIST:={} 
LOCAL qtd:=1,preco:=0 
LOCAL posreg:=0, precxquant:=0, cDescricao:=SPACE(40), maisum:=0, numLin:=0 


IF SELECT("PRODUTO")=0 
   USE Produto alias Produto new shared 
   Index on codprod TAG iProdCod TO PRODUTO.CDX 
ENDIF 

DBSELECTAR("FILETEMP") 
linha:=ROW() 

IF MODO==0 .OR. MODO==1 .OR. MODO==3 
   RETURN 1 
ELSEIF MODO==2 
   LOCATE FOR FILETEMP->codprod == SPACE(06) 
   IF FILETEMP->( !FOUND() ) 
      APPEND BLANK 
   ENDIF 
   FILETEMP->( DBGOTOP() )
   KEYBOARD  K_CTRL_PGDN
   RETURN 1
ELSEIF MODO==4 
  IF LASTKEY()!=K_ESC 
     linha  := ROW() 
     numLin:=ROW() 

     Produto->( ORDSETFOCUS(1) ) 
     codigo  := FILETEMP->codprod 
     @ numLin,08 GET codigo pict "999999" color",r/w" 
     READ 
     Produto->( ORDSETFOCUS(1) ) 
     IF Produto->( !DBSEEK( STRZERO(VAL(codigo),6 )) ) 
        alert("Produto com o codigo "+ALLTRIM(codigo)+" nao localizado") 
        RETURN 1 
       ENDIF 
     codigo:=Produto->codprod 
     DBSELECTAR("FILETEMP") 
       posreg := FILETEMP->( RECNO() ) 
     preco:=precod:=Produto->vendaprod 
     @ linha,08 SAY Produto->codprod COLOR "R/W" 
     cDescricao:=Produto->descprod 

     FILETEMP->descprod   := cDescricao 
     FILETEMP->descricao  := left(cDescricao,25) 

     @ linha,15 SAY left(cDescricao,25) COLOR "R/W" 
     @ linha,53 SAY preco PICTURE "@E 9999.99" COLOR "R/W" 
     @ linha,41 GET qtd PICTURE "@E 9,999,999" valid qtd>0 
     read 

     IF Produto->codprod==FILETEMP->codprod 
        preco:=FILETEMP->vendaprod 
     ENDIF 

     precxquant := preco * qtd 

     FILETEMP->codprod   := Produto->codprod 
     FILETEMP->descricao := left(cDescricao,25) 
     FILETEMP->quant     := qtd 
     FILETEMP->vendaprod := preco 
     FILETEMP->total     := precxquant 

     maisum:=FILETEMP->( RECNO() ) 

     // 02/07/2007
     // OBJETIVO-> MANTER SEMPRE UM REGISTRO AO FINAL NA TELA PARA DIGITACAO
     IF maisum > 8
        SKIP 2
     ENDIF

     FILETEMP->( DBSKIP() )

     posreg := FILETEMP->( RECNO() ) 
     FILETEMP->( DBGOTO(maisum) ) 
     FILETEMP->( DBGOTO(posreg) ) 

     IF !EMPTY(FILETEMP->codprod) 
        FILETEMP->( DBGOTOP() )
        KEYBOARD  K_CTRL_PGDN
        RETURN 1
     ENDIF 

     LOCATE FOR FILETEMP->codprod == SPACE(06) 
     IF FILETEMP->( !FOUND() ) 
        APPEND BLANK 
     ENDIF 
     FILETEMP->( DBGOTOP() )

     // 02/07/2007
     // OBJETIVO -> POSICIONAR NO PROXIMO REGISTRO ABAIXO
     // XHARBOUR 32 BITS  X CLIPPER 5.X
     KEYBOARD  K_CTRL_PGDN

     RETURN 1
  ELSEIF LASTKEY()=K_ESC 
     DBCLOSEALL() 
     CLS 
     QUIT 
  ENDIF 
ENDIF 
RETURN 1