//------------- PROCEDURE RELRESCV //------------- // Objetivo...: Imprimir Relat¢rio Resumo de Compras e Vendas do Mˆs. LOCAL cor := SETCOLOR(), cur := SETCURSOR(), t, t1 LOCAL arq, ape, cab[8], pic[8], dad[8] LOCAL fil, cabf[1], dadf[1], picf[1] LOCAL prn, oprn := {"Imprimir", "Sair"}, pag, pg, esc LOCAL x, ox := {"Maior Consumo", "Maior Lucro(%)","Descricao"} LOCAL dt, dti, dtf, data := DATE(), temc, temv, temcv LOCAL cod, fnom, sd, sdfis, sdfin, sdc, sdv LOCAL qtc, vlc, qtv, vlv,vlr,vlp LOCAL aRes, aResumo LOCAL aFor, aPro, item, cabs[1], pics[1] LOCAL ftot := ftot1 := fqt := flr := flp := 0 LOCAL aArq := {}, qt,qt1,qt3 LOCAL fg, ofg := {"Fat. Por Filial", "Fat. Geral"} LOCAL gg, ogg := {"Bloco de Notas", "Proprio programa", "Bloco de notas(moderno)"} LOCAL f, of := {"Produtos", "Servicos","Sair"} PRIVATE fnomfil PRIVATE aItem SETCURSOR(1) SET DECIMALS TO 3 SET FIXED ON AADD(aArq,{"002",PADR("Fil",10)}) AADD(aArq,{"015","Pro"}) AADD(aArq,{"010","For"}) AADD(aArq,{"017","Gru"}) AADD(aArq,{"085","Codcx"}) AADD(aArq,{"220","Pv"}) AADD(aArq,{"222","Pvf"}) AADD(aArq,{"226","Pvd"}) AADD(aArq,{"225","Pvi"}) AADD(aArq,{"350","Rep"}) IF !Abrirarq(aArq) Fechararq(aArq) RETURN ENDIF DBSELECTAR("Pro") // Filtrar Somente Para as Filiais. // Or‡amento somente de produtos com corte OK. //DBSETFILTER( { || trim(pro->linha) = "PA" }) dbselectar("Pvi") f:=alert("Selecionar relatorio de:",of) if lastkey() = K_ESC Fechararq(aArq) return endif if f = 1 DBSETFILTER( { || pvi->tipopro = "P" }) elseif f = 2 DBSETFILTER( { || pvi->tipopro = "S" }) elseif f = 3 Fechararq(aArq) return endif Abrejan(02,00,23,79,frame[5]) @ 01,00 SAY Mmenu[4] if f = 1 @ 02,20 SAY PADC("RELATORIO QTDS X CUSTOS x VENDAS - PRODUTOS",40) COLOR "GR+/B" elseif f = 2 @ 02,20 SAY PADC("RELATORIO QTDS X CUSTOS x VENDAS - SERVICOS",40) COLOR "GR+/B" endif t := SAVESCREEN(00,00,24,79) dti := CTOD("01/" + STRZERO(MONTH(data),2) + "/" + STR(YEAR(data),4)) //dti := CTOD("01/" + STRZERO(MONTH(data),2) + "/" + SUBSTR(STR(YEAR(data)),4,2)) dtf := DATE() //fnomfil := Emp->nomfil fnomfil := SPACE(10) DO WHILE .T. RESTSCREEN(00,00,24,79,t) /* Fil(fnomfil) IF LASTKEY() = K_ESC EXIT ENDIF */ SETCOLOR(Mcor[2]) @ 03,02 SAY "Data Inicial :" @ 04,02 SAY "Data Final:" @ 05,02 SAY "F i l i a l.:" SETCOLOR(Mcor[1]) @ 03,17 GET dti @ 04,17 GET dtf VALID dtf >= dti @ 05,16 SAY fnomfil READ IF LASTKEY() = K_ESC EXIT ENDIF temc := .T. ; temv := .T. ; temcv := .T. dt := dti DBSELECTAR("Pvi") ORDSETFOCUS("DTPV") DO WHILE .T. IF DBSEEK(DTOS(dt)) .OR. dt > dtf EXIT ENDIF dt++ ENDDO IF dt > dtf temv := .F. ENDIF IF !temv Mensagem("N„o Existe Vendas Neste Intervalo de Datas !!!", 3) LOOP ENDIF fg := ALERT("Tipo de Faturamento",ofg) IF fg = 1 // Faturamento Por Filial. Fil(fnomfil) IF LASTKEY() = K_ESC LOOP ENDIF ELSE fnomfil := "G E R A L" ENDIF @ 05,15 SAY fnomfil // colocar para selecionar filial e grupo /* DBSELECTAR("Fil") DBGOTOP() IF LASTREC() = 1 fil := Fil->nomfil ELSE fil := SPACE(10) t1 := SAVESCREEN(06,25,23,55) cabf[1] := "Nome da Filial" ; dadf[1] := "Fil->nomfil" Achakey("Fil",08,30,22,50,cabf,dadf,picf,0,fil) SETCOLOR(Mcor[1]) SETCURSOR(1) RESTSCREEN(06,25,23,55,t1) IF LASTKEY() # K_ENTER LOOP ENDIF fil := Fil->nomfil SETCOLOR(Mcor[2]) @ 05,02 SAY "F i l i a l.:" SETCOLOR(Mcor[1]) @ 05,16 SAY fil ENDIF */ /* aItem := {} ; aFor := {} // fun‡„o para selecionar itens de matriz. DBSELECTAR("Pro") ORDSETFOCUS("NOMFOR") DBSELECTAR("For") DBGOTOP() DO WHILE !EOF() DBSELECTAR("Pro") IF DBSEEK(For->nomfor) item := " " + For->nomfor AADD(aItem, item ) ENDIF DBSELECTAR("For") DBSKIP() ENDDO IF LEN(aItem) = 0 Mensagem("N„o Existe Fornecedores Cadastrados !!!", 2) LOOP ENDIF t1:=SAVESCREEN(05,00,23,78) cabs[1] := " Nome do Fornecedor" ; pics[1] := "@!" Sel(aItem,06,23,22,56,cabs,pics) // SAFUN.PRG RESTSCREEN(05,00,23,78,t1) SETCOLOR(Mcor[1]) FOR i = 1 TO LEN(aItem) IF SUBSTR(aItem[i], 1, 1) = "û" IF DBSEEK(SUBSTR(aItem[i], 3)) AADD(aFor, For->nomfor ) ENDIF ENDIF NEXT IF EMPTY(aFor) LOOP ENDIF SETCOLOR(Mcor[2]) @ 06,02 SAY "Fornecedores :" SETCOLOR(Mcor[1]) lin := 06 ; col := 17 FOR i = 1 TO LEN(aFor) @ lin,col SAY TRIM(aFor[i]) col += LEN(TRIM(aFor[i])) + 2 IF col > 46 lin++ ; col := 17 ENDIF IF lin > 07 EXIT ENDIF NEXT */ aItem := {} ; aFor := {} // fun‡„o para selecionar itens de matriz. DBSELECTAR("Pro") ORDSETFOCUS("GRUPO") DBSELECTAR("Gru") DBGOTOP() DO WHILE !EOF() DBSELECTAR("Pro") IF DBSEEK(gru->grupo) item := " " + gru->grupo AADD(aItem, item ) ENDIF DBSELECTAR("Gru") DBSKIP() ENDDO IF LEN(aItem) = 0 Mensagem("N„o Existe Grupos Cadastrados !!!", 2) LOOP ENDIF t1:=SAVESCREEN(05,00,23,78) cabs[1] := " Nome do Grupo" ; pics[1] := "@!" Sel(aItem,06,23,22,56,cabs,pics) // SAFUN.PRG RESTSCREEN(05,00,23,78,t1) SETCOLOR(Mcor[1]) FOR i = 1 TO LEN(aItem) IF SUBSTR(aItem[i], 1, 1) = "û" IF DBSEEK(SUBSTR(aItem[i], 3)) AADD(aFor, gru->grupo) ENDIF ENDIF NEXT IF EMPTY(aFor) LOOP ENDIF SETCOLOR(Mcor[2]) @ 06,02 SAY "Grupos :" SETCOLOR(Mcor[1]) lin := 06 ; col := 17 FOR i = 1 TO LEN(aFor) @ lin,col SAY TRIM(aFor[i]) col += LEN(TRIM(aFor[i])) + 2 IF col > 46 lin++ ; col := 17 ENDIF IF lin > 07 EXIT ENDIF NEXT aItem := {} ; aPro := {} DBSELECTAR("Pro") ORDSETFOCUS("CODPRO") DBGOTOP() DO WHILE !EOF() IF Pro->grupo # "VIDRO" // VER ISTO IF ASCAN(aFor, Pro->grupo) = 0 DBSKIP() LOOP ENDIF item := " " + Pro->codpro item += " " + Pro->nompro AADD(aItem, item ) ENDIF DBSKIP() ENDDO IF LEN(aItem) = 0 Mensagem("N„o Existe Produtos/Servicos Cadastrados !!!", 2) LOOP ENDIF t1:=SAVESCREEN(04,00,23,78) cabs[1] := " C¢digo" ; pics[1] := "@!" Sel(aItem,08,05,22,75,cabs,pics) // SEFUN.PRG RESTSCREEN(04,00,23,78,t1) SETCOLOR(Mcor[1]) FOR i = 1 TO LEN(aItem) IF SUBSTR(aItem[i], 1, 1) = "û" IF DBSEEK(SUBSTR(aItem[i], 3,10)) AADD(aPro, Pro->codpro) ENDIF ENDIF NEXT IF EMPTY(aPro) LOOP ENDIF SETCOLOR(Mcor[2]) @ 08,02 SAY "Produtos.....:" SETCOLOR(Mcor[1]) lin := 08 ; col := 17 FOR i = 1 TO LEN(aPro) @ lin,col SAY TRIM(aPro[i]) col += LEN(TRIM(aPro[i])) + 2 IF col > 66 lin++ ; col := 17 IF lin > 22 EXIT ENDIF ENDIF NEXT IF !Confirma("S") LOOP ENDIF aRes := {} ; aResumo := {} ; sdc := sdv := 0 ftot := 0 ftot1 := 0 fqt := 0 flr := 0 flp := 0 //aIF temv // tem venda. DBSELECTAR("Pvi") DO WHILE KD(Pvi->dtpv) <= DTOS(dtf) .AND. !EOF() @ 24,00 SAY PADC("Processando Venda: "+Pvi->pv+" "+Pvi->codpro,80) IF fg = 1 IF Pvi->nomfil # fnomfil DBSKIP() LOOP ENDIF ENDIF /* IF Pvi->nomfil # fnomfil //fil DBSKIP() LOOP ENDIF */ /* IF Pvi->quant <= 0 DBSKIP() LOOP ENDIF */ DBSELECTAR("Pv") IF DBSEEK(Pvi->pv) /* IF Pv->condpag = "TEF" DBSELECTAR("Pvi") DBSKIP() LOOP ENDIF */ /* IF Pv->condpag = "999" sdv += Pv->vtotal ENDIF */ ENDIF DBSELECTAR("Pro") IF !DBSEEK(Pvi->codpro) DBSELECTAR("Pvi") DBSKIP() LOOP ENDIF IF ASCAN(aPro, Pvi->codpro) = 0 DBSELECTAR("Pvi") DBSKIP() LOOP ENDIF DBSELECTAR("Pvi") cod := Pvi->codpro qt := Pvi->quant /* if trim(fgru)= "RACAO GRANEL" ftotal := fpunit ELSE ftotal := fquant * fpunit endif*/ // vl := qt * Pvi->punit if trim(pvi->grupo) = "RACAO GRANEL" vl := Pvi->punit ELSE vl := qt * pvi->punit endif // vl := VAL(STR(vl,9,4)) // so str DBSELECTAR("Pro") IF DBSEEK(cod) fnom := Pro->nompro fcusto := Pro->custo // fnom2 := pro->nomepro2 // cu := qt * fcusto // cu := VAL(STR(cu,9,4)) ENDIF cu := qt * fcusto lur := vl - cu // lur := VAL(STR(lur,9,4)) lup := (lur / vl) * 100 // lup := VAL(STR(lup,9,2)) // lup := IF(lup < -99, 0, lup) // lup := IF(lup > 999, 0, lup) a := ASCAN(aRes,cod) IF a = 0 AADD(aRes,cod) // AADD(aResumo,{cod, 0, 0, qt, vl}) //a AADD(aResumo,{cod, fnom, qt, cu, vl, lur, fnom}) // AADD(aResumo,{cod, fnom, qt, cu, vl, 0,lup fnom}) // AADD(aResumo,{cod, fnom, qt, vl, cu, lur,0}) //lup // fnom // AADD(aResumo,{cod, fnom, qt, vl, cu,lur,0,fnom2}) //lup // fnom AADD(aResumo,{cod, fnom, qt, vl, cu,lur,0}) //lup // fnom ELSE aResumo[a,3] += qt aResumo[a,4] += vl aResumo[a,5] += cu aResumo[a,6] += lur // aResumo[a,7] := lup ENDIF DBSELECTAR("Pvi") DBSKIP() ENDDO // ENDIF IF LEN(aResumo) = 0 Mensagem("N„o Existe Vendas Neste Intervalo de Datas",2) LOOP ENDIF x := alert("Classificar relat¢rio por:",ox) if x = 1 // colocar para imprimir o nompro e nao o abrev ASORT(aResumo,,,{ |x,y| x[3] > y[3]}) // ASORT(aResumo,,,{ |x,y| x[2]+str(x[3],9,3) < y[2]+str(y[3],9,3)}) // ASORT(aResumo,,,{ |x,y| val(substr(x[3],6,2))+x[2]+x[1] < val(substr(y[3],6,2))+y[2]+y[1]}) // converter colocar val e jogar na matriz o item elseif x = 2 ASORT(aResumo,,,{ |x,y| x[7] > y[7]}) elseif x = 3 ASORT(aResumo,,,{ |x,y| x[2]+str(x[3],9,3) < y[2]+str(y[3],9,3)}) endif FOR a = 1 TO LEN(aResumo) qt := aResumo[a,3] vl := aResumo[a,4] cu := aResumo[a,5] lur := aResumo[a,6] // aResumo[a,6] := vl - cu // aResumo[a,6] := VAL(STR(aResumo[a,6],9,4)) aResumo[a,7] := (lur / vl) * 100 // venda media calculada //aResumo[a,7] := VAL(STR(aResumo[a,7],9,3)) //+" AUMENTAR A CSA DECIMAL EM MAIS 1 /??? // aResumo[a,7] := (lur / vl ) * 100 // aResumo[a,7] := IF(aResumo[a,7] < -99, 0, aResumo[a,7]) // aResumo[a,7] := aResumo[a,7] := IF(aResumo[a,7] > 999, 0, aResumo[a,7]) ftot += cu ftot1 += vl fqt += qt flr += lur //aResumo[a,6] // flp += aResumo[a,7] flp := (flr / ftot1) * 100 // flp := STR(flp,9,2) +"%" // flp1=int(flp*100)/100 aqui trunca // flp := STR(flp,6,3) +"%" // flp := round(flp,3) // ftotal := ((int(fquant * fpunit * 100)) / 100) //truncando o valor // ftotal := fquant * fpunit // ftotal := ((int(ftotal * 100)) / 100 // flp := STR(flp,9,2)+"%" // SOMENTE STR @ 03,30 SAY "Tot.Custo:" @ 03,40 SAY ftot PICT "@E 999,999,999.99" @ 04,30 SAY "Tot.Vendas:" @ 04,41 SAY ftot1 PICT "@E 999,999,999.99" @ 05,30 SAY "Lucro(R$):" @ 05,40 SAY flr PICT "@E 999,999,999.99" // usar trabsform @ 03,56 SAY "Lucro(%):" @ 03,65 SAY flp PICT "@E 999,999.99" //"@E 999999.99" @ 04,56 SAY "Tot.Qtds:" @ 04,66 SAY fqt PICT "@E 999,999.99" // colocar mascara de acordo com UN NEXT /* IF !EMPTY(aPag) ASORT(aPag,,,{|x,y| x[1]+DTOS(x[2])+x[4] < y[1]+DTOS(y[2])+y[4]}) AADD(aPag,{"T o t a l","",fqt,"","",SPACE(40)}) cab[1] := "Filial" cab[2] := "Data Vcto." cab[3] := "Vl. Docto." ; pic[3] := "@E 999,999.99" cab[4] := "Documento" cab[5] := "Data Docto" cab[6] := "Fornecedor" TONE(2550,5) Mensagem("Existe Contas a Pagar Vencida !!!",1.5) Vermat(aPag,05,02,22,77,cab,pic,.F.) ENDIF*/ IF !EMPTY(aResumo) //ASORT(aPag,,,{|x,y| x[1]+DTOS(x[2])+x[4] < y[1]+DTOS(y[2])+y[4]}) // AADD(aResumo,{"T o t a l","",totvenc,"","",SPACE(40)}) cab[1] := "Prod." cab[2] := "Descricao" cab[3] := "Qt.Vend" ; pic[3] := "@E 999,999.99" cab[4] := "Vl.Vendas" ; pic[4] := "@E 999,999.99" cab[5] := "Vl.Custos " ; pic[5] := "@E 999,999.99" cab[6] := "Lucro(R$)" ; pic[6] := "@E 999,999.99" cab[7] := "Lucro(%)" ; pic[7] := "@E 999,999.99" // cab[8] := "Descricao Completa" @ 24,00 SAY SPACE(80) @ 24,00 SAY "ESC=Sair F9=Imprime" COLOR "W+/B" // Vermatriz(aResumo,06,00,23,79,cab, pic, .F.,1) Vermat2(aResumo,06,00,23,79,cab, pic,.F.,1) // ,1 ENDIF @ 24,00 SAY SPACE(80) IF LASTKEY() = K_F9 /* @ 24,00 SAY SPACE(80) @ 24,00 SAY "ENTER=Sair F9=Imprime" COLOR "W+/B" Vermatriz(aResumo,06,00,23,79,cab, pic, .F.,1) // Vermat(aResumo,06,00,23,79,cab, pic, .F.,1) //@ 24,00 SAY SPACE(80) IF LASTKEY() = K_F9 */ DO WHILE .T. /* IF !ISPRINTER() prn := ALERT("Impressora Nao Est  Preparada. Verificar Impressora !!! ", oprn) IF prn = 1 LOOP ELSE EXIT ENDIF ENDIF */ SET PRINTER TO RELRESCV.TXT SET DEVICE TO PRINTER SET PRINT ON SET CONSOLE OFF DBSELECTAR("Pro") qtc := vlc := vlr := vlp := qtv := vlv := sd := 0 pag := 0 ; pg := .T. ; esc := .F. FOR a := 1 TO LEN(aResumo) IF pg pg := .F. @ 00,00 SAY fnomemp @ 00,40 SAY "Emis: " + DTOC(DATE()) @ 00,58 SAY "Hora: " + SUBSTR(TIME(),1,5) @ 00,71 SAY "Pag.: " + STRZERO(++pag,3,0) if f = 1 @ 01,00 SAY "Rel. Qts(s) x Custos x Vendas - PRODUTOS" elseif f = 2 @ 01,00 SAY "Rel. Qts(s) x Custos x Vendas - SERVICOS" endif @ 01,PCOL()+1 SAY "Filial " + fnomfil //fil @ 01,PCOL()+1 SAY "De " + DTOC(dti) @ 01,PCOL()+1 SAY "A " + DTOC(dtf) @ 01,76 SAY Mmenu[5] @ 02,00 SAY "*" + REPL("=",102) + "*" @ 03,00 SAY "PROD." @ 03,06 SAY "DESCRICAO" @ 03,40 SAY "QT.VD" @ 03,51 SAY "VL.VENDA" @ 03,63 SAY "VL.CUSTO" @ 03,75 SAY "LUCRO(R$)" @ 03,87 SAY "LUCRO(%)" @ 04,00 SAY "*" + REPL("=",102) + "*" @ 05,00 SAY " " ENDIF IF Escprint() esc := .T. EXIT ENDIF @ PROW()+1,00 SAY aResumo[a,1] cod := SPACE(30) cod2 := space(65) IF DBSEEK(aResumo[a,1]) // cod := Pro->abrev cod := trim(SUBSTR(Pro->nompro,1,30)) // cod2 := trim(Pro->nomepro2) // cod := SUBSTR(Pro->nompro,1,30) ENDIF /* if empty(cod) cod := substr(Pro->nompro,1,30) endif */ @ PROW(),06 SAY cod @ PROW(),40 SAY aResumo[a,3] PICT "@E 999,999.99" @ PROW(),51 SAY aResumo[a,4] PICT "@E 999,999.99" @ PROW(),63 SAY aResumo[a,5] PICT "@E 999,999.99" @ PROW(),75 SAY aResumo[a,6] PICT "@E 999,999.99" @ PROW(),87 SAY aResumo[a,7] PICT "@E 999,999.99" //"@E 999999.99" // @ PROW()+1,00 SAY cod2 @ PROW()+1,00 SAY "*" + REPL("-",102) + "*" vlv += aResumo[a,4] ; qtv += aResumo[a,3] ; vlc += aResumo[a,5] vlr += aResumo[a,6] ; vlp := (vlr / vlv) * 100 SET DEVICE TO SCREEN SET PRINT OFF SET CONSOLE ON @ 24,00 SAY PADC("Imprimindo Produto " + cod, 80) SET DEVICE TO PRINTER SET PRINT ON SET CONSOLE OFF IF PROW() > 58 pg := .T. ENDIF NEXT IF esc EXIT ENDIF @ PROW()+2,00 SAY "Totais do Relatorio: " @ PROW() ,40 SAY qtv PICT "@E 999,999.99" @ PROW() ,51 SAY vlv PICT "@E 999,999.99" @ PROW() ,63 SAY vlc PICT "@E 999,999.99" @ PROW() ,75 SAY vlr PICT "@E 999,999.99" @ PROW() ,87 SAY vlp PICT "@E 999,999.99" //"@E 999999.99" // copiar as mesmas mascaras da consulta e chmar na segunda linha /* @ PROW()+2,00 SAY "Saldo Fisico Prod.:" @ PROW() ,20 SAY sdfis PICT "@E 99,999" @ PROW() ,40 SAY "Saldo Financeiro Prod.:" @ PROW() ,64 SAY sdfin PICT "@E 999,999,999.99" */ EJECT SET PRINTER TO SET DEVICE TO SCREEN // aumentar para 90 ou 120 140 !NOTEPAD.EXE RELRESCV.TXT /* gg := alert("Imprimir para ... ",ogg) if gg = 1 ! start NOTEPAD.EXE RELRESCV.TXT elseif gg = 2 !nodosimp.exe relrescv.txt 96 /sel/pre elseif gg = 3 !start notepad++.exe relrescv.txt endif */ SET PRINT OFF SET CONSOLE ON EXIT ENDDO ENDIF ENDDO //dbsetfilter() Fechararq(aArq) SETCOLOR(cor) SETCURSOR(cur) //dbsetfilter() RETURN