Para compilar uso HbMake v1.20 - Copyright 2000-2007 , xHarbour build 1.0.0 Intl.(simplex) / Borland C++ 5.5.1
Código: Selecionar todos
*-* SISTEMA : ESCRITURACAO FISCAL / ESTOQUES
*-* AUTOR : JOSE MALTA
*-* MODULO : CONSULTA / ALTERA PRODUTO - CADASTRO E PRECO
*-* PROGRAMA: EST32C
*-* DATA : 14/04/2004
*
PROCEDURE EST32C
SET COLOR TO &COR5
@ 03,56 SAY ' EST32C'
@ 24,00 CLEAR TO 24,79
FuncaoBar( "EST32C" )
DT = DATE()
HR = TIME()
DT = DTOS(DT)
SET COLOR TO &COR3,&COR6,,,&COR3
@ 00,00 CLEAR TO 23,79
setcolor(cor5+','+cor6)
@ 00,00 CLEAR TO 00,79
@ 00,00 SAY EMPRESA
@ 00,41 SAY 'CONSULTA / ALTERA PRODUTO '
@ 00,74 SAY 'EST32C'
@ 24,00 CLEAR TO 24,79
sele empresas
seek codempresa
sele parametr
seek '01'
IT = SPACE(20)
ET = 'E'
DO WHILE .T.
* JANELA SECUNDARIA
SET COLOR TO &COR3,&COR6,,,&COR3
@ 02,05 SAY 'INFORME NOME: '
@ 02,20 GET IT PICT '@!'
@ 02,45 SAY 'TODOS / COM ESTOQUE (T/E):'
@ 02,73 GET ET PICT '@!' VALID ET $ 'ET'
READ
IF LASTKEY() = 27
RETURN
ENDIF
IF IT = SPACE(20)
MENS('W+/R','EST32C - NOME DO PRODUTO TEM PREENCHIMENTO OBRIGATORIO.')
LOOP
ENDIF
N = 1
DO WHILE .T.
*************
SET COLOR TO W+/R
@ 22,02 SAY;
' ENTER - CONSULTA ITEM F2 - ALTERA ITEM F3 - ALTERA PRECO VENDA '
SET COLOR TO &COR3,&COR6,,,&COR3
TTT = LEN(TRIM(IT))
SELE ESTITEM
SET ORDER TO 3
SEEK CODEMPRESA + TRIM(IT)
IF EOF() .OR. !FOUND()
MENS('W+/R','EST32C - NAO EXISTEM ITENS CADASTRADOS.')
EXIT
ELSE
@ 24,00 CLEAR TO 24,79
@ 24,00 say 'Aguarde ... Gerando lista.'
SELE ESTITEM
x = 0
DECLARE WCAMPO [300]
for xji = 1 to 300
wcampo[xji] = space(74)
next
TSALDO1 = 0
TSALDO2 = 0
UN1 = ' '
UN2 = ' '
WHILE !EOF() .AND. CODEMPRESA = ITEMPR .AND. ;
SUBSTR(ITDESC,1,TTT) = TRIM(IT) .AND. x < 300
WITCOD = ITCOD
WITDESC = ITDESC
WITAPRESENT = ITAPRESENT
WITPRINCATV = ITPRINCATV
WITFTCONV = ITFTCONV
WITUNVEN = ITUNVEN
WITUNCOM = ITUNCOM
WITATIVA = ITATIVA
SELE ESTPRECO
SEEK CODEMPRESA + STR(WITCOD,5)
IF !FOUND()
WITPRECO = 0
ELSE
WITPRECO = 0
ZXAV1 = CODEMPRESA + STR(WITCOD,5) + DT
ZXAV = ITEMPR + STR(ITCOD,5) + DTOS(ITDATA)
WHILE !EOF() .AND. !(ZXAV > ZXAV1)
WITPRECO = ITPRECO
SKIP
ZXAV = ITEMPR + STR(ITCOD,5) + DTOS(ITDATA)
ENDDO
ENDIF
SELE ESTSLD
SET ORDER TO 2
SEEK CODEMPRESA + STR(WITCOD,5)
IF FOUND()
WSALDO = SLDATU11 (DATAPROC1,'*',WITCOD)
IF (WSALDO = 0 .AND. ET = 'T') .OR. ;
WSALDO <> 0
IF WITFTCONV > 1
WSALDO = WSALDO * WITFTCONV
wsaldo = round(wsaldo,0)
ENDIF
IF WITUNVEN = SPACE(3) .AND. UN1 = ' '
UN1 = 'UN'
TSALDO1 = TSALDO1 + WSALDO
ELSEIF WITUNVEN = SPACE(3) .AND. UN2 = ' '
UN2 = 'UN'
TSALDO1 = TSALDO1 + WSALDO
ELSEIF UN1 = ' '
UN1 = WITUNVEN
TSALDO1 = TSALDO1 + WSALDO
ELSEIF UN1 = WITUNVEN
TSALDO1 = TSALDO1 + WSALDO
ELSEIF UN2 = ' '
UN2 = WITUNVEN
TSALDO2 = TSALDO2 + WSALDO
ELSE
UN2 = WITUNVEN
TSALDO2 = TSALDO2 + WSALDO
ENDIF
WSALDO = STR(WSALDO,9,3) + WITUNVEN
x = x + 1
if x > 300
exit
endif
WCAMPO[X] = ' ' + WITDESC + ' ' + C179 + str(WITCOD,6) + ' ' + C179 +;
STR(WITPRECO,8,2) + ' ' + C179 + WSALDO +;
' ' + C179 + ' ' + WITATIVA + ' '
ENDIF
ELSEIF ET = 'T'
x = x + 1
if x > 300
exit
endif
WCAMPO[X] = ' ' + WITDESC + ' ' + C179 + str(WITCOD,6) ;
+ ' ' + C179 + STR(WITPRECO,8,2) + ' ' + C179 ;
+ ' 0.000 ' + ' ' + C179 + ' ' + WITATIVA + ' '
ENDIF
SELE ESTSLD
SET ORDER TO 1
SELE ESTITEM
SKIP
ENDDO
@ 24,00
if x > 300
@ 24,00 say 'Encontrados mais de 300 itens na pesquisa. Mostrados os 300 primeiros itens.'
endif
IF X = 0
MENS('W+/R','NAO EXISTEM PRODUTOS EM ESTOQUE COM ARGUMENTO DE PESQUISA SOLICITADO.')
EXIT
ENDIF
SAVE SCREEN TO XXX
SET COLOR TO
LIN = 2
@ LIN+1,00 CLEAR TO LIN+19,79
@ LIN+1,00 TO LIN+19,79 DOUBLE
@ lin+2,01 SAY ' DESCRICAO ' ;
+ C179 + ' COD. ' + C179 + ' PRECO ' + C179 ;
+ ' ESTOQUE ' + C179 + 'ATV'
@ LIN+3,01 SAY REPL('=',78)
declare xcampo [x]
for xji = 1 to x
xcampo[xji] = wcampo[xji]
next
IF N < 10
NN = 1
ELSE
NN = N - 5
ENDIF
@ 23,00 CLEAR TO 23,79
IF TSALDO2 <> 0 .AND. TSALDO1 <> 0
@ 23,00 SAY ;
'QUANTIDADE TOTAL DO ITEM PESQUISADO: ' + UN2 + STR(TSALDO2,9,2) + ' ' + UN1 + STR(TSALDO1,9,2)
ELSEIF TSALDO2 = 0 .AND. TSALDO1 <> 0
@ 23,00 SAY ;
'QUANTIDADE TOTAL DO ITEM PESQUISADO: ' + UN1 + STR(TSALDO1,9,2)
ELSEIF TSALDO2 <> 0 .AND. TSALDO1 = 0
@ 23,00 SAY ;
'QUANTIDADE TOTAL DO ITEM PESQUISADO: ' + UN2 + STR(TSALDO2,9,2)
ELSE
@ 23,00 SAY ;
'QUANTIDADE TOTAL DO ITEM PESQUISADO: ' + UN2 + STR(TSALDO2,9,2) + ' ' + UN1 + STR(TSALDO1,9,2)
ENDIF
N = ACHOICE(lin+4,01,lin+18,78,xcampo," ","FUNC32C",N,NN)
REST SCREEN FROM XXX
SET COLOR TO &COR3,&COR6,,,&COR3
IF N > 0 .AND. N < X+1
IF LASTKEY() <> 27
ITEM = substr(xcampo[N],45,5)
ITEM = val(ITEM)
ITEM = STR(ITEM,5)
ELSE
EXIT
ENDIF
ELSE
* MENS('W+/R','ITEM FORA DO LIMITE:' + STR(N,3))
EXIT
ENDIF
@ 24,00
ENDIF
@ 22,02 SAY ;
' '
@ 24,00
SET COLOR TO &COR3,&COR6,,,&COR3
LOOP
ENDDO
LOOP
ENDDO
RETURN
FUNCTION FUNC32C
PARAMETERS AMODE, APOS, ASCR
* AMODE - MODO DO ACHOICE
* APOS - NUM ELMTOS ARRAY ATIVOS
* ASCR - NUM ELMTOS TELA
/*
@ 24,00 SAY AMODE
@ 24,15 SAY APOS
@ 24,30 SAY ASCR
@ 24,45 SAY LASTKEY()
@ 24,60 SAY N
*/
ITEM = substr(xcampo[APOS],45,5)
ITEM = val(ITEM)
ITEM = STR(ITEM,5)
COR32C = SETCOLOR()
/*
@ 25,00 SAY ITEM
INKEY(30)
*/
do case
case lastkey() = -1
SAVE SCREEN TO T32C
EST32 ( ITEM )
REST SCREEN FROM T32C
SET COLOR TO &COR32C
return(2)
case lastkey() = -2
* W1ITCOD = ITEM
SAVE SCREEN TO T32C
ESTF3N ( ITEM )
REST SCREEN FROM T32C
SET COLOR TO &COR32C
return(2)
case lastkey() = 13
SAVE SCREEN TO T32C
EST56 ( ITEM )
REST SCREEN FROM T32C
SET COLOR TO &COR32C
return (2)
case lastkey() = 27
return(1)
otherwise
return(2)
endcase