Meu modo de trabalho

[Itamar M. Lins Jr.]

Ola!
Sintegra em 2020!
https://pctoledo.org/forum/viewto ... 20&t=24033

Saudações,
Itamar M. Lins Jr.

[JoséQuintas]

Faltam só dois fontes, pra acabar com o jpcadastro.dbf.
Mas... como eu disse... deixei os mais complicados para o final.
Não sei qual dos dois é pior.... kkkkk

Além de já usar comando SQL, ainda tem dois temporários até chegar no relatório, que tem opções diferentes.
Quem mandou fazer assim.... kkkkk

Mas entra o que falei: deixando os mais difíceis pro final, "talvez" com o conhecimento adquirido com os outros, este fique mais fácil.
A tela do computador chega a ficar pequena pra entender as "tranqueiras" do fonte.

Código: Selecionar todos

STATIC FUNCTION Imprime()

   LOCAL nCont, mTmpFile, oPDF, aTransacaoList, cTexto, nKey, cTxt, oFile
   LOCAL nNumTransa, mRelCliente, mRelVendedor, mRelItem, mRelRaiz, mCampos
   LOCAL mComissao, mCabeca, mChaves, mRaizCnpj, mStruOk
   LOCAL nTotMargem := Array(5), nTotComissao := Array(5 ), nTotCusto := Array(5), nTotVenda := Array(5)
   LOCAL nTotQtde := Array(5), nTotEmbalagem := Array(5), cTotChave := Array(5), nTotRecNo := Array(5)
   LOCAL cnSQL := ADOClass():New( AppConexao() )

   mTmpFile := { MyTempFile( "dbf" ), MyTempFile( "cdx" ), MyTempFile( "dbf" ), MyTempFile( "cdx" ) }

   FOR nCont = 1 TO 4
      fErase( mTmpFile[ nCont ] )
   NEXT

   mStruOk := { ;
      { "CHAVE1",     "C", 50, 0 }, ;
      { "CHAVE2",     "C", 50, 0 }, ;
      { "CHAVE3",     "C", 50, 0 }, ;
      { "CHAVE4",     "C", 50, 0 }, ;
      { "PDCADASTRO", "C", 6, 0 }, ;
      { "CDCNPJ",     "C", 10, 0 }, ;
      { "PDVENDEDOR", "C", 6, 0 }, ;
      { "IPPRODUTO",  "C", 6, 0 }, ;
      { "DESCITEM",   "C", 30, 0 }, ;
      { "PDTRANSA",   "C", 6, 0 }, ;
      { "NF",         "C", 9, 0 }, ;
      { "OBS",        "C", 50, 0 }, ;
      { "DATEMI",     "D", 8, 0 }, ;
      { "IPQTDE",     "N", 14, 0 }, ;
      { "QTDEMB",     "N", 14, 0 }, ;
      { "IPVALCUS",   "N", 15, 2 }, ;
      { "IPVALNOT",   "N", 15, 2 }, ;
      { "MARGEM",     "N", 15, 2 }, ;
      { "PMARGEM",    "N", 8, 3 }, ;
      { "VALCOM",     "N", 15, 2 }, ;
      { "PERCOM",     "N", 4, 1 }, ;
      { "NIVEL",      "C", 1, 0 } } // usado para totalizar

   dbCreate( mTmpFile[ 1 ], mStruOk )
   dbCreate( mTmpFile[ 3 ], mStruOk )

   SELECT 0
   USE ( mTmpFile[ 3 ] ) ALIAS temp2
   SELECT 0
   USE ( mTmpFile[ 1 ] ) ALIAS Temp

   WITH OBJECT cnSQL
      :cSQL := "SELECT IDPEDIDO, PDCADASTRO, PDVENDEDOR, PDTRANSA," + ;
         " PDPEDCLI," + ;
         " IF( JPNOTFIS.NFNOTFIS IS NULL, JPPEDIDO.PDDATEMI, JPNOTFIS.NFDATEMI ) AS DATEMI," + ;
         " IF( JPNOTFIS.NFNOTFIS IS NULL, JPPEDIDO.PDPEDCLI, JPNOTFIS.NFNOTFIS ) AS NOTFIS," + ;
         " JPTRANSA.TRDESCRI AS TRANOME, JPTRANSA.TRREACAO AS REACAO," + ;
         " JPNOTFIS.NFNOTFIS AS NOTFIS," + ;
         " JPITPED.IPPRODUTO, JPITPED.IPQTDE, JPITPED.IPVALCUS, JPITPED.IPVALNOT," + ;
         " JPITEM.IEPRODEP, JPITEM.IEQTDCOM," + ;
         " JPCADASTRO.CDCNPJ" + ;
         " FROM JPPEDIDO" + ;
         " LEFT JOIN JPNOTFIS ON JPNOTFIS.NFPEDIDO = JPPEDIDO.IDPEDIDO" + ;
         " LEFT JOIN JPTRANSA ON JPTRANSA.IDTRANSA = JPPEDIDO.PDTRANSA" + ;
         " LEFT JOIN JPITPED ON JPITPED.IPPEDIDO = JPPEDIDO.IDPEDIDO" + ;
         " LEFT JOIN JPITEM ON JPITEM.IDPRODUTO = JPITPED.IPPRODUTO" + ;
         " LEFT JOIN JPCADASTRO ON JPCADASTRO.IDCADASTRO = JPPEDIDO.PDCADASTRO" + ;
         " WHERE PDCONF = 'S'" + ;
         " AND PDTRANSA IN (" + ;
            " SELECT IDTRANSA FROM JPTRANSA AS LISTAA WHERE "
      IF nOpcCompraVenda == 1
         :cSQL += " TRREACAO LIKE '%VENDA%'"
      ELSEIF nOpcCompraVenda == 2
         :cSQL += " TRREACAO LIKE '%COMPRA%'"
      ELSE
         :cSQL += " ( TRREACAO LIKE '%COMPRA%' OR TRREACAO LIKE '%VENDA%' )"
      ENDIF
      IF nOpcDevol == 2
         :cSQL += " AND TRREACAO LIKE '%DEV%'"
      ENDIF
      :cSQL += " )"
      IF nOpcVendedor == 2
         :cSQL += " AND PDVENDEDOR = " + NumberSQL( mIdVendedor )
      ENDIF
      IF nOpcCadastro == 2
         :cSQL += " AND PDCADASTRO IN (" + ;
            " SELECT IDCADASTRO FROM JPCADASTRO AS LISTA WHERE LEFT( CDCNPJ, 11 ) = " + ;
            " ( SELECT LEFT( CDCNPJ, 11 ) FROM JPCADASTRO AS ESCOLHIDO WHERE IDCADASTRO = " + NumberSQL( nIdCadastro ) + " ) )"
      ENDIF
      IF nOpcProduto == 2
         :cSQL += " AND JPITEM.IDPRODUTO = " + NumberSQL( nIdProduto )
      ENDIF
      IF nOpcProDep == 2
         :cSQL += " AND JPITEM.IEPRODEP = " + NumberSQL( nIdProDep )
      ENDIF
      :cSQL += " AND ( JPNOTFIS.NFNOTFIS IS NOT NULL OR NOT" + ;
         " JPPEDIDO.PDTRANSA IN ( SELECT IDTRANSA FROM JPTRANSA AS LISTAB WHERE TRREACAO LIKE '%N+%' OR TRREACAO LIKE '%N-%' ) )" + ;
         " AND IF( JPNOTFIS.NFNOTFIS IS NULL, PDDATEMI, NFDATEMI ) BETWEEN CAST( " + DateSQL( dDataInicial ) + " AS DATE )" + ;
               " AND CAST( " + DateSQL( dDataFinal ) + " AS DATE )"
      :Execute()
      DO WHILE ! :Eof()
         GrafProc()
         Inkey()
         Encontra( StrZero( :Number( "PDCADASTRO" ), 6 ), "jpcadastro", "numlan" )
         Encontra( StrZero( :Number( "IPPRODUTO" ), 6 ), "jpitem", "item" )
         SELECT temp
         RecAppend()
         REPLACE ;
            temp->pdCadastro WITH StrZero( :Number( "PDCADASTRO" ), 6 ), ;
            temp->pdVendedor WITH StrZero( :Number( "PDVENDEDOR" ), 6 ), ;
            temp->ipProduto  WITH StrZero( :Number( "IPPRODUTO" ), 6 ), ;
            temp->cdCnpj     WITH :String( "CDCNPJ", 10 ), ;
            temp->pdTransa   WITH StrZero( :Number( "PDTRANSA" ), 6 ), ;
            temp->ipQtde     WITH :Number( "IPQTDE" ), ;
            temp->QtdEmb     WITH :Number( "IPQTDE" ) * Max( 1, :Number( "IEQTDCOM" ) ), ;
            temp->ipValCus   WITH :Number( "IPVALCUS" ), ;
            temp->ipValNot   WITH :Number( "IPVALNOT" ), ;
            temp->Obs        WITH :String( "TRANOME" ), ;
            temp->NF         WITH StrZero( :Number( "NOTFIS" ), 9 ), ;
            temp->DatEmi     WITH :Date( "DATEMI" ), ;
            temp->Margem     WITH :Number( "IPVALNOT" ) - :Number( "IPVALCUS" )
         IF "DEV" $ :String( "REACAO" )
            REPLACE ;
               temp->ipQtde   WITH -temp->ipQtde, ;
               temp->QtdEmb   WITH -temp->QtdEmb, ;
               temp->ipValCus WITH -temp->ipValCus, ;
               temp->ipValNot WITH -temp->ipValNot
         ENDIF
         IF temp->ipValNot <> 0 // Evita "estouro"
            mMargem := Max( Min( ( temp->ipValNot - temp->ipValCus ) / temp->ipValNot * 100, 999 ), -99.9 )
            REPLACE temp->PMargem WITH mMargem
         ELSE
            mMargem := 0
         ENDIF
         IF ADORecCount( "JPCOMISSAO", "CMVENDEDOR = " + NumberSQL( :Number( "PDVENDEDOR" ) ) + " AND CMPRODEP = " + NumberSQL( :Number( "IEPRODEP" ) ) ) != 0
            mComissao := ADOField( "CMVALOR", "N", "JPCOMISSAO", "CMVENDEDOR = " + NumberSQL( :Number( "PDVENDEDOR" ) ) + " AND CMPRODEP = " + NumberSQL( :Number( "IEPRODEP" ) ) )
         ELSE
            mComissao := ADOField( "VDCOMISSAO", "N", "JPVENDEDOR", "IDVENDEDOR = " + NumberSQL( :Number( "PDVENDEDOR" ) ) )
         ENDIF
         REPLACE ;
            temp->ValCom WITH temp->ipValNot * mComissao / 100, ;
            temp->PerCom WITH mComissao
         RecUnlock()
         :MoveNext()
      ENDDO
   ENDWITH

   mCabeca := { "VENDEDOR", "ITEM", "CNPJ", "CLIENTE" }

   DO CASE
   CASE nOpcOrdem == 1 ; mChaves := { 1, 2, 3, 4 }
   CASE nOpcOrdem == 2 ; mChaves := { 2, 1, 3, 4 }
   CASE nOpcOrdem == 3 ; mChaves := { 3, 4, 2, 1 }
   CASE nOpcOrdem == 4 ; mChaves := { 1, 3, 4, 2 }
   CASE nOpcOrdem == 5 ; mChaves := { 2, 3, 4, 1 }
   CASE nOpcOrdem == 6 ; mChaves := { 3, 4, 1, 2 }
   ENDCASE

   SELECT temp
   INDEX ON temp->cdCnpj + Str( 1000000 - RecNo(), 7 ) TO ( mTmpFile[ 2 ] )
   GOTO TOP
   aTransacaoList := {}
   DO WHILE ! Eof()
      mRaizCnpj := temp->cdCnpj
      Encontra( temp->pdCadastro, "jpcadastro", "numlan" ) // pra pegar desc cnpj
      mRelRaiz := iif( Eof(), "*RAIZ CNPJ* " + temp->cdCnpj, Pad( jpcadastro->cdNome, 40 ) + temp->cdCnpj )
      DO WHILE temp->cdCnpj == mRaizCnpj .AND. ! Eof()
         Encontra( temp->pdCadastro, "jpcadastro", "numlan" )
         mRelCliente := iif( Empty( jpcadastro->cdNome ), "*CLIENTE* " + temp->pdCadastro, Pad( jpcadastro->cdNome, 40 ) + temp->pdCadastro )
         mRelVendedor := Pad( ADOField( "VDDESCRI", "C", "JPVENDEDOR", "IDVENDEDOR=" + NumberSQL( temp->pdVendedor ) ), 40 ) + temp->pdVendedor
         Encontra(temp->ipProduto,"jpitem","item")
         mRelItem := iif( Empty( jpitem->ieDescri ), "*ITEM* " + temp->ipProduto, Pad( jpitem->ieDescri, 40 ) + temp->ipProduto )
         mCampos := { mRelVendedor, mRelItem, mRelRaiz, mRelCliente }
         nNumTransa := 0
         FOR nCont = 1 TO Len( aTransacaoList )
            IF aTransacaoList[ nCont, 1 ] == temp->pdTransa
               nNumTransa := nCont
               EXIT
            ENDIF
         NEXT
         IF nNumTransa == 0
            AAdd( aTransacaoList, { temp->pdTransa, 0 } )
            nNumTransa := Len( aTransacaoList )
         ENDIF
         aTransacaoList[ nNumTransa, 2 ] += temp->ipValNot
         RecLock()
         REPLACE ;
            temp->Chave1 WITH mCampos[ mChaves[ 1 ] ], ;
            temp->Chave2 WITH mCampos[ mChaves[ 2 ] ], ;
            temp->Chave3 WITH mCampos[ mChaves[ 3 ] ], ;
            temp->Chave4 WITH mCampos[ mChaves[ 4 ] ]
         RecUnlock()
         SKIP
      ENDDO
   ENDDO
   SET INDEX TO

   SELECT Temp
   INDEX ON temp->Chave1 + temp->Chave2 + temp->Chave3 + temp->Chave4 TO ( mTmpFile[ 4 ] )
   GOTO TOP
   STORE 0 To nTotQtde[ 1 ], nTotCusto[ 1 ], nTotVenda[ 1 ], nTotMargem[ 1 ], nTotComissao[ 1 ], nTotEmbalagem[ 1 ]
   SELECT temp2
   RecAppend()
   RecUnlock()
   SELECT temp
   GOTO TOP
   DO WHILE ! Eof()
      Inkey()
      STORE 0 To nTotQtde[ 2 ], nTotCusto[ 2 ], nTotVenda[ 2 ], nTotMargem[ 2 ], nTotComissao[ 2 ], nTotEmbalagem[ 2 ]
      cTotChave[ 2 ] := temp->Chave1
      SELECT Temp2
      RecAppend()
      REPLACE ;
         temp2->Chave1 WITH cTotChave[ 2 ], ;
         temp2->Nivel  WITH "1"
      RecUnlock()
      nTotRecNo[ 2 ] := RecNo()
      SELECT Temp
      DO WHILE ! Eof()
         Inkey()
         IF cTotChave[ 2 ] != temp->Chave1
            EXIT
         ENDIF
         STORE 0 To nTotQtde[ 3 ], nTotCusto[ 3 ], nTotVenda[ 3 ], nTotMargem[ 3 ], nTotComissao[ 3 ], nTotEmbalagem[ 3 ]
         cTotChave[ 3 ] := temp->Chave2
         SELECT temp2
         RecAppend()
         REPLACE ;
            temp2->Chave1 WITH cTotChave[ 2 ], ;
            temp2->Chave2 WITH cTotChave[ 3 ], ;
            temp2->Nivel  WITH  "2"
         RecUnlock()
         nTotRecNo[ 3 ] := RecNo()
         SELECT temp
         DO WHILE ! Eof()
            Inkey()
            IF cTotChave[ 2 ] != temp->Chave1
               EXIT
            ENDIF
            IF cTotChave[ 3 ] != temp->Chave2
               EXIT
            ENDIF
            STORE 0 TO nTotQtde[ 4 ], nTotCusto[ 4 ], nTotVenda[ 4 ], nTotMargem[ 4 ], nTotComissao[ 4 ], nTotEmbalagem[ 4 ]
            cTotChave[ 4 ] := temp->Chave3
            SELECT temp2
            RecAppend()
            REPLACE ;
               temp2->Chave1 WITH cTotChave[ 2 ], ;
               temp2->Chave2 WITH cTotChave[ 3 ], ;
               temp2->Chave3 WITH cTotChave[ 4 ], ;
               temp2->Nivel  WITH  "3"
            RecUnlock()
            nTotRecNo[ 4 ] := RecNo()
            SELECT temp
            DO WHILE ! Eof()
               Inkey()
               IF cTotChave[ 2 ] != temp->Chave1
                  EXIT
               ENDIF
               IF cTotChave[ 3 ] != temp->Chave2
                  EXIT
               ENDIF
               IF cTotChave[ 4 ] != temp->Chave3
                  EXIT
               ENDIF
               STORE 0 To nTotQtde[ 5 ], nTotCusto[ 5 ], nTotVenda[ 5 ], nTotMargem[ 5 ], nTotComissao[ 5 ], nTotEmbalagem[ 5 ]
               cTotChave[ 5 ] := temp->Chave4
               SELECT temp2
               RecAppend()
               REPLACE ;
                  temp2->Chave1 WITH cTotChave[ 2 ], ;
                  temp2->Chave2 WITH cTotChave[ 3 ], ;
                  temp2->Chave3 WITH cTotChave[ 4 ], ;
                  temp2->Chave4 WITH cTotChave[ 5 ], ;
                  temp2->Nivel  WITH "4"
               RecUnlock()
               nTotRecNo[ 5 ] := RecNo()
               SELECT temp
               DO WHILE ! Eof()
                  Inkey()
                  IF cTotChave[ 2 ] != temp->Chave1
                     EXIT
                  ENDIF
                  IF cTotChave[ 3 ] != temp->Chave2
                     EXIT
                  ENDIF
                  IF cTotChave[ 4 ] != temp->Chave3
                     EXIT
                  ENDIF
                  IF cTotChave[ 5 ] != temp->Chave4
                     EXIT
                  ENDIF
                  SELECT temp2
                  RecAppend()
                  FOR nCont = 1 TO FCount()
                     FieldPut( nCont, temp->( FieldGet( nCont ) ) )
                  NEXT
                  REPLACE temp2->Nivel WITH  "5"
                  SELECT temp
                  nTotQtde[ 5 ]      += temp->ipQtde
                  nTotEmbalagem[ 5 ] += temp->QtdEmb
                  nTotCusto[ 5 ]     += temp->ipValCus
                  nTotVenda[ 5 ]     += temp->ipValNot
                  nTotMargem[ 5 ]    += temp->Margem
                  nTotComissao[ 5 ]  += temp->ValCom
                  SKIP
               ENDDO
               SELECT temp2
               GOTO ( nTotRecNo[ 5 ] )
               RecLock()
               REPLACE ;
                  temp2->ipQtde   WITH nTotQtde[ 5 ], ;
                  temp2->QtdEmb   WITH nTotEmbalagem[ 5 ], ;
                  temp2->ipValCus WITH nTotCusto[ 5 ], ;
                  temp2->ipValNot WITH nTotVenda[ 5 ], ;
                  temp2->Margem   WITH nTotMargem[ 5 ], ;
                  temp2->ValCom   WITH nTotComissao[ 5 ], ;
                  temp2->PMargem  WITH Max( Min( ( nTotVenda[ 5 ] - nTotCusto[ 5 ] ) / nTotVenda[ 5 ] * 100, 999 ), -99.9 )
               RecUnlock()
               SELECT temp
               nTotQtde[ 4 ]      += nTotQtde[ 5 ]
               nTotEmbalagem[ 4 ] += nTotEmbalagem[ 5 ]
               nTotCusto[ 4 ]     += nTotCusto[ 5 ]
               nTotVenda[ 4 ]     += nTotVenda[ 5 ]
               nTotMargem[ 4 ]    += nTotMargem[ 5 ]
               nTotComissao[ 4 ]  += nTotComissao[ 5 ]
            ENDDO
            SELECT temp2
            GOTO ( nTotRecNo[ 4 ] )
            RecLock()
            REPLACE ;
               temp2->ipQtde   WITH nTotQtde[ 4 ], ;
               temp2->QtdEmb   WIth nTotEmbalagem[ 4 ], ;
               temp2->ipValCus WITH nTotCusto[ 4 ], ;
               temp2->ipValNot WITH nTotVenda[ 4 ], ;
               temp2->Margem   WITH nTotMargem[ 4 ], ;
               temp2->ValCom   WITH nTotComissao[ 4 ], ;
               temp2->PMargem  WITH Max( Min( ( nTotVenda[ 4 ] - nTotCusto[ 4 ] ) / nTotVenda[ 4 ] * 100, 999 ), -99.9 )
            RecUnlock()
            SELECT temp
            nTotQtde[ 3 ]      += nTotQtde[ 4 ]
            nTotEmbalagem[ 3 ] += nTotEmbalagem[ 4 ]
            nTotCusto[ 3 ]     += nTotCusto[ 4 ]
            nTotVenda[ 3 ]     += nTotVenda[ 4 ]
            nTotMargem[ 3 ]    += nTotMargem[ 4 ]
            nTotComissao[ 3 ]  += nTotComissao[ 4 ]
         ENDDO
         SELECT temp2
         GOTO ( nTotRecNo[ 3 ] )
         RecLock()
         REPLACE ;
            temp2->ipQtde   WITH nTotQtde[ 3 ], ;
            temp2->QtdEmb   WITH nTotEmbalagem[ 3 ], ;
            temp2->ipValCus WITH nTotCusto[ 3 ], ;
            temp2->ipValNot WITH nTotVenda[ 3 ], ;
            temp2->Margem   WITH nTotMargem[ 3 ], ;
            temp2->ValCom   WITH nTotComissao[ 3 ], ;
            temp2->PMargem  WITH Max( Min( ( nTotVenda[ 3 ] - nTotCusto[ 3 ] ) / nTotVenda[ 3 ] * 100, 999 ), -99.9 )
         RecUnlock()
         SELECT temp
         nTotQtde[ 2 ]      += nTotQtde[ 3 ]
         nTotEmbalagem[ 2 ] += nTotEmbalagem[ 3 ]
         nTotCusto[ 2 ]     += nTotCusto[ 3 ]
         nTotVenda[ 2 ]     += nTotVenda[ 3 ]
         nTotMargem[ 2 ]    += nTotMargem[ 3 ]
         nTotComissao[ 2 ]  += nTotComissao[ 3 ]
      ENDDO
      SELECT temp2
      GOTO ( nTotRecNo[ 2 ] )
      RecLock()
      REPLACE ;
         temp2->ipQtde   WITH nTotQtde[ 2 ], ;
         temp2->QtdEmb   WITH nTotEmbalagem[ 2 ], ;
         temp2->ipValCus WITH nTotCusto[ 2 ], ;
         temp2->ipValNot WITH nTotVenda[ 2 ], ;
         temp2->Margem   WITH nTotMargem[ 2 ], ;
         temp2->ValCom   WITH nTotComissao[ 2 ], ;
         temp2->PMargem  WITH Max( Min( ( nTotVenda[ 2 ] - nTotCusto[ 2 ] ) / nTotVenda[ 2 ] * 100, 999 ), -99.9 )
      RecUnlock()
      SELECT temp
      nTotQtde[ 1 ]      += nTotQtde[ 2 ]
      nTotEmbalagem[ 1 ] += nTotEmbalagem[ 2 ]
      nTotCusto[ 1 ]     += nTotCusto[ 2 ]
      nTotVenda[ 1 ]     += nTotVenda[ 2 ]
      nTotMargem[ 1 ]    += nTotMargem[ 2 ]
      nTotComissao[ 1 ]  += nTotComissao[ 2 ]
   ENDDO
   SELECT temp2
   GOTO TOP
   RecLock()
   REPLACE ;
      temp2->ipQtde   WITH nTotQtde[ 1 ], ;
      temp2->QtdEmb   WITH nTotEmbalagem[ 1 ], ;
      temp2->ipValCus WITH nTotCusto[ 1 ], ;
      temp2->ipValNot WITH nTotVenda[ 1 ], ;
      temp2->Margem   WITH nTotMargem[ 1 ], ;
      temp2->ValCom   WITH nTotComissao[ 1 ], ;
      temp2->PMargem  WITH Max( Min( ( nTotVenda[ 1 ] - nTotCusto[ 1 ] ) / nTotVenda[ 1 ] * 100, 999 ), -99.9 )
   RecUnlock()
   SELECT temp
   USE

   oPDF := PDFClass():New()
   oPDF:SetType( nOpcPrinterType )
   oPDF:Begin()
   nKey := 0
   oPDF:acHeader := { "COMPRAS/VENDAS NO PERIODO" }
   cTexto := "Periodo:" + iif( nOpcData == 1, "Tudo", Dtoc( dDataInicial ) + " a " + Dtoc( dDataFinal ) )
   cTexto += " Tipo:" + acTxtCompraVenda[ nOpcCompraVenda ]
   cTexto += " " + acTxtDetalhe[ nOpcDetalhe ]
   cTexto += " Depto:" + iif( nOpcProDep == 1, "Todos", NumberSQL( nIdProDep ) + "-" + Trim( AUXPRODEPClass():Descricao( nIdProDep ) ) )
   Encontra( StrZero( nIdProduto, 6 ), "jpitem", "item" )
   cTexto += " Produto:" + iif( nOpcProduto==1, "Todos", NumberSQL( nIdProduto ) + "-" + Trim( jpitem->ieDescri ) )
   cTexto += " Vendedor:" + iif( nOpcVendedor == 1, "Todos", NumberSQL( mIdVendedor ) + "-" + ADOField( "VDDESCRI", "C", "JPVENDEDOR", "IDVENDEDOR=" + NumberSQL( mIdVendedor ) ) )
   AAdd( oPDF:acHeader, cTexto )
   cTexto := Pad( mCabeca[ mChaves[ 1 ] ] + "/" + mCabeca[ mChaves[ 2 ] ] + "/" + mCabeca[ mChaves[ 3 ] ], 50 ) + ;
      " ----QTD---- --QTD.NF.-- " + Iif( nOpcCusto == 2, "---VL.CUSTO--- ", "" ) + ;
      "---VL.PEDIDO-- " + Iif( nOpcCusto == 2, "---VL.MARGEM-- %MARGEM ", "" ) + "    COMISSAO/%"
   AAdd( oPDF:acHeader, cTexto )
   oPDF:PageHeader()
   STORE Chr(205) TO cTotChave[ 2 ], cTotChave[ 3 ], cTotChave[ 4 ]
   SELECT temp2
   GOTO TOP
   SKIP // Primeiro registro total
   DO WHILE nKey != K_ESC .AND. ! Eof()
      GrafProc()
      nKey := Inkey()
      IF temp2->Nivel > Str( nOpcDetalhe, 1 )
         SKIP
         LOOP
      ENDIF
      oPDF:MaxRowTest()
      cTxt := ""
      IF temp2->Nivel == "1" // cTotChave[ 2 ] != temp2->Chave1
         oPDF:nRow += 1
         oPDF:MaxRowTest()
         cTxt := Pad( temp2->Chave1, 40 )
         cTotChave[ 2 ] := temp2->Chave1
         cTotChave[ 3 ] := Chr(205)
         cTotChave[ 4 ] := Chr(205)
         cTotChave[ 5 ] := Chr(205)
      ELSEIF temp2->Nivel == "2" // cTotChave[ 3 ] != temp2->Chave2 .AND. nOpcDetalhe > 1
         oPDF:MaxRowTest()
         cTotChave[ 3 ] := Pad( temp2->Chave2, 40 )
         cTxt := Space(2) + temp2->Chave2
         cTotChave[ 4 ] := Chr(205)
         cTotChave[ 5 ] := Chr(205)
      ELSEIF temp2->Nivel == "3" // cTotChave[ 4 ] != temp2->Chave3 .AND. nOpcDetalhe > 2
         cTotChave[ 4 ] := temp2->Chave3
         oPDF:MaxRowTest()
         cTxt := Space(4) + Pad( temp2->Chave3, 40 )
         cTotChave[ 5 ] := Chr(205)
      ELSEIF temp2->Nivel == "4" // cTotChave[ 5 ] != temp2->Chave4 .AND. nOpcDetalhe > 3
         cTotChave[ 5 ] := temp2->Chave4
         oPDF:MaxRowTest()
         cTxt := Space(6) + Pad( temp2->Chave4, 40 )
      ELSEIF temp2->Nivel == "5"
         cTxt := Space(22) + temp2->Nf + " " + Dtoc( temp2->DatEmi )
      ENDIF
      cTxt := Pad( cTxt, 50 )
      cTxt += " " + Transform( temp2->QtdEmb, PicVal(9) )
      cTxt += " " + Transform( temp2->ipQtde, PicVal(9) )
      IF nOpcCusto == 2
         cTxt += " " + Transform( temp2->ipValCus, PicVal(11,2) )
      ENDIF
      cTxt += " " + Transform( temp2->ipValNot, PicVal(11,2) )
      IF temp2->Nivel < "3"
         oPDF:DrawZebrado(2)
      ELSE
         oPDF:DrawZebrado(1)
      ENDIF
      IF nOpcCusto == 2
         cTxt += " " + Transform( temp2->Margem, PicVal(11,2) )
         cTxt += " " + Transform( temp2->PMargem, "@E 999.9" )
      ENDIF
      IF nOpcComComissao == 2
         cTxt += " " + Transform( temp2->ValCom, PicVal( 8, 2 ) )
         cTxt += " " + "(" + Transform( temp2->PerCom, "@Z 999.999" ) + ")"
      ENDIF
      oPDF:DrawText( oPDF:nRow, 0, cTxt )
      IF nOpcDetalhe == 5 .AND. ! Empty( temp2->Obs )
         oPDF:nRow += 1
         cTxt := " " + temp2->Obs
         cTxt := Padl( cTxt, oPDF:MaxCol() )
         oPDF:DrawText( oPDF:nRow, 0, cTxt )
      ELSE
      ENDIF
      oPDF:nRow += 1
      SKIP
   ENDDO
   GOTO TOP
   oPDF:nRow += 2
   oPDF:MaxRowTest()
   cTxt := Pad( "***TOTAIS***", 50 )
   cTxt += " " + Transform( temp2->QtdEmb, PicVal(9) )
   cTxt += " " + Transform( temp2->ipQtde, PicVal(9) )
   IF nOpcCusto == 2
      cTxt += " " + Transform( temp2->ipValCus, PicVal(11,2) )
   ENDIF
   cTxt += " " + Transform( temp2->ipValNot, PicVal(11,2) )
   IF nOpcCusto == 2
      cTxt += " " + Transform( temp2->Margem, PicVal(11,2) )
      cTxt += " " + Transform( temp2->PMargem, "@E 999.9" )
   ENDIF
   cTxt += " " + Transform( temp2->ValCom, PicVal(8,2) )
   oPDF:DrawText( oPDF:nRow, 0, cTxt )
   IF nOpcAnalise == 2
      oPDF:nRow += 2
      oPDF:MaxRowTest()
      FOR nCont = 1 TO Len( aTransacaoList )
         oPDF:MaxRowTest()
         cTxt := aTransacaoList[ nCont, 1 ]
         cTxt += " " + Transform( aTransacaoList[ nCont, 2 ], PicVal( 14, 2 ) )
         cTxt += " " + DescricaoJPTRANSA( aTransacaoList[ nCont, 1 ] )
         oPDF:DrawText( oPDF:nRow, 0, cTxt )
         oPDF:nRow += 1
      NEXT
   ENDIF
   SELECT temp2
   USE
   FOR EACH oFile IN mTmpFile
      fErase( oFile )
   NEXT
   oPDF:End()

   RETURN NIL

Até seria mais fácil gravando o que precisa no temporário.... mas sabe como é... tentar eliminar fonte Harbour.

[JoséQuintas]

Nessas horas eu vou rodeando primeiro....
Por exemplo aqui:

Código: Selecionar todos

         nNumTransa := 0
         FOR nCont = 1 TO Len( aTransacaoList )
            IF aTransacaoList[ nCont, 1 ] == temp->pdTransa
               nNumTransa := nCont
               EXIT
            ENDIF
         NEXT
         IF nNumTransa == 0
            AAdd( aTransacaoList, { temp->pdTransa, 0 } )
            nNumTransa := Len( aTransacaoList )
         ENDIF

O primeiro FOR/NEXT pode ser eliminado com o uso de hb_AScan().
Já reduz um pouquinho o fonte.....

Código: Selecionar todos

         nNumTransa := hb_ASCan( aTransacaoList, { | e | e[ 1 ] == temp->pdTransa } )
         IF nNumTransa == 0
            AAdd( aTransacaoList, { temp->pdTransa, 0 } )
            nNumTransa := Len( aTransacaoList )
         ENDIF

Menos fonte pra resolver....

[JoséQuintas]

Por enquanto, a idéia é tentar eliminar o primeiro temporário.
Para isso, procurei passar o máximo possível para o comando SQL, assim vém pronto.

Código: Selecionar todos

      :Execute()
      DO WHILE ! :Eof()
         GrafProc()
         Inkey()
         Encontra( StrZero( :Number( "PDCADASTRO" ), 6 ), "jpcadastro", "numlan" )
         Encontra( StrZero( :Number( "IPPRODUTO" ), 6 ), "jpitem", "item" )
         SELECT temp
         RecAppend()
         REPLACE ;
            temp->pdCadastro WITH StrZero( :Number( "PDCADASTRO" ), 6 ), ;
            temp->pdVendedor WITH StrZero( :Number( "PDVENDEDOR" ), 6 ), ;
            temp->ipProduto  WITH StrZero( :Number( "IPPRODUTO" ), 6 ), ;
            temp->cdCnpj     WITH :String( "CDCNPJ", 10 ), ;
            temp->pdTransa   WITH StrZero( :Number( "PDTRANSA" ), 6 ), ;
            temp->ipQtde     WITH :Number( "FATOR" ) * :Number( "IPQTDE" ), ;
            temp->QtdEmb     WITH :Number( "FATOR" ) * :Number( "IPQTDE" ) * Max( 1, :Number( "IEQTDCOM" ) ), ;
            temp->ipValCus   WITH :Number( "FATOR" ) * :Number( "IPVALCUS" ), ;
            temp->ipValNot   WITH :Number( "FATOR" ) * :Number( "IPVALNOT" ), ;
            temp->Obs        WITH :String( "TRANOME" ), ;
            temp->NF         WITH StrZero( :Number( "NOTFIS" ), 9 ), ;
            temp->DatEmi     WITH :Date( "DATEMI" ), ;
            temp->Margem     WITH :Number( "IPVALNOT" ) - :Number( "IPVALCUS" )
            temp->ValCom     WITH :Number( "FATOR" ) * temp->ipValNot * :Number( "COMISSAO" ) / 100, ;
            temp->PerCom     WITH :Number( "COMISSAO" )
         IF temp->ipValNot <> 0 // Evita "estouro"
            mMargem := Max( Min( ( Abs( temp->ipValNot ) - Abs( temp->ipValCus ) ) / Abs( temp->ipValNot ) * 100, 999 ), -99.9 )
            REPLACE temp->PMargem WITH mMargem
         ELSE
            mMargem := 0
         ENDIF
         RecUnlock()
         :MoveNext()
      ENDDO
      :CloseRecordset()
   ENDWITH

O que sobrou é resultado de cálculo, então, talvez pelo menos seja eliminado um temporário.
Não vejo a hora de terminar tudo, mas... melhor um pouco de cada vez.

[JoséQuintas]

Foi o que deu: ainda resta um temporário pra eliminar, mas pelo menos ficou mais rápido e um pouco menor.

Código: Selecionar todos

STATIC FUNCTION Imprime()

   LOCAL nCont, mTmpFile, oPDF, aTransacaoList, cTexto, nKey, cTxt, oFile
   LOCAL nNumTransa, mStruOk
   LOCAL nTotMargem := Array(5), nTotComissao := Array(5 ), nTotCusto := Array(5), nTotVenda := Array(5)
   LOCAL nTotQtde := Array(5), nTotEmbalagem := Array(5), cTotChave := Array(4), nTotRecNo := Array(5)
   LOCAL aChaveList
   LOCAL cnSQL := ADOClass():New( AppConexao() )

   mTmpFile := { MyTempFile( "dbf" ), MyTempFile( "cdx" ), MyTempFile( "dbf" ), MyTempFile( "cdx" ) }

   FOR nCont = 1 TO 4
      fErase( mTmpFile[ nCont ] )
   NEXT
   DO CASE
   CASE nOpcOrdem == 1; aChaveList := { "VENDEDOR", "PRODUTO", "GRUPOCLIENTE", "CLIENTE" }
   CASE nOpcOrdem == 2; aChaveList := { "PRODUTO", "VENDEDOR", "GRUPOCLIENTE", "CLIENTE" }
   CASE nOpcOrdem == 3; aChaveList := { "GRUPOCLIENTE", "CLIENTE", "PRODUTO", "VENDEDOR" }
   CASE nOpcOrdem == 4; aChaveList := { "VENDEDOR", "GRUPOCLIENTE", "CLIENTE", "PRODUTO" }
   CASE nOpcOrdem == 5; aChaveList := { "PRODUTO", "GRUPOCLIENTE", "CLIENTE", "VENDEDOR" }
   CASE nOpcOrdem == 6; aChaveList := { "GRUPOCLIENTE", "CLIENTE", "VENDEDOR", "PRODUTO" }
   ENDCASE

   mStruOk := { ;
      { "CHAVE1",     "C", 50, 0 }, ;
      { "CHAVE2",     "C", 50, 0 }, ;
      { "CHAVE3",     "C", 50, 0 }, ;
      { "CHAVE4",     "C", 50, 0 }, ;
      { "PDCADASTRO", "C", 6, 0 }, ;
      { "CDCNPJ",     "C", 10, 0 }, ;
      { "PDVENDEDOR", "C", 6, 0 }, ;
      { "IPPRODUTO",  "C", 6, 0 }, ;
      { "DESCITEM",   "C", 30, 0 }, ;
      { "PDTRANSA",   "C", 6, 0 }, ;
      { "NF",         "C", 9, 0 }, ;
      { "OBS",        "C", 50, 0 }, ;
      { "DATEMI",     "D", 8, 0 }, ;
      { "IPQTDE",     "N", 14, 0 }, ;
      { "QTDEMB",     "N", 14, 0 }, ;
      { "IPVALCUS",   "N", 15, 2 }, ;
      { "IPVALNOT",   "N", 15, 2 }, ;
      { "MARGEM",     "N", 15, 2 }, ;
      { "PMARGEM",    "N", 8, 3 }, ;
      { "VALCOM",     "N", 15, 2 }, ;
      { "PERCOM",     "N", 4, 1 }, ;
      { "NIVEL",      "C", 1, 0 } } // usado para totalizar

   dbCreate( mTmpFile[ 1 ], mStruOk )

   SELECT 0
   USE ( mTmpFile[ 1 ] ) ALIAS temp2

   WITH OBJECT cnSQL
      :cSQL := "SELECT IDPEDIDO, PDCADASTRO, PDVENDEDOR, PDTRANSA," + ;
         " PDPEDCLI," + ;
         " IF( JPNOTFIS.NFNOTFIS IS NULL, JPPEDIDO.PDDATEMI, JPNOTFIS.NFDATEMI ) AS DATEMI," + ;
         " IF( JPNOTFIS.NFNOTFIS IS NULL, JPPEDIDO.PDPEDCLI, JPNOTFIS.NFNOTFIS ) AS NOTFIS," + ;
         " JPTRANSA.TRDESCRI AS TRANOME, JPTRANSA.TRREACAO AS REACAO," + ;
         " JPNOTFIS.NFNOTFIS AS NOTFIS," + ;
         " JPITPED.IPPRODUTO," + ;
         " JPITPED.IPQTDE," + ;
         " JPITPED.IPVALCUS, JPITPED.IPVALNOT," + ;
         " JPITEM.IEPRODEP," + ;
         " CONCAT( RPAD( JPVENDEDOR.VDDESCRI, 40, ' ' ), LPAD( PDVENDEDOR, 6, ' ' ) ) AS VENDEDOR," + ;
         " CONCAT( RPAD( JPITEM.IEDESCRI, 40, ' ' ), LPAD( IPPRODUTO, 6, ' ' ) ) AS PRODUTO," + ;
         " CONCAT( RPAD( PRECNPJ.CNPJNOME, 40, ' ' ), LPAD( JPCADASTRO.CDCNPJ, 10, ' ' ) ) AS GRUPOCLIENTE," + ;
         " CONCAT( RPAD( JPCADASTRO.CDNOME, 40, ' ' ), LPAD( PDCADASTRO, 10, ' ' ) ) AS CLIENTE," + ;
         " IF( JPITEM.IEQTDCOM = 0, 1, JPITEM.IEQTDCOM ) * JPITPED.IPQTDE AS QTDEMBALAGEM," + ;
         " JPITPED.IPVALNOT - JPITPED.IPVALCUS AS VMARGEM," + ;
         " IF( JPITPED.IPVALNOT = 0, 0, ( JPITPED.IPVALNOT - JPITPED.IPVALCUS ) / JPITPED.IPVALNOT * 100 ) AS PMARGEM," + ;
         " RPAD( JPCADASTRO.CDCNPJ, 10, ' ' ) AS CNPJRAIZ," + ;
         " IF( JPTRANSA.TRREACAO LIKE '%DEV%', -1, 1 ) AS FATOR," + ;
         " IF( JPCOMISSAO.CMVALOR IS NOT NULL, JPCOMISSAO.CMVALOR, IF( JPVENDEDOR.VDCOMISSAO IS NULL, 0, JPVENDEDOR.VDCOMISSAO ) ) AS PCOMISSAO," + ;
         " IF( JPCOMISSAO.CMVALOR IS NOT NULL, JPCOMISSAO.CMVALOR, IF( JPVENDEDOR.VDCOMISSAO IS NULL, 0, JPVENDEDOR.VDCOMISSAO ) ) * JPITPED.IPVALNOT / 100 AS VCOMISSAO" + ;
         " FROM JPPEDIDO" + ;
         " LEFT JOIN JPNOTFIS ON JPNOTFIS.NFPEDIDO = JPPEDIDO.IDPEDIDO" + ;
         " LEFT JOIN JPTRANSA ON JPTRANSA.IDTRANSA = JPPEDIDO.PDTRANSA" + ;
         " LEFT JOIN JPITPED ON JPITPED.IPPEDIDO = JPPEDIDO.IDPEDIDO" + ;
         " LEFT JOIN JPITEM ON JPITEM.IDPRODUTO = JPITPED.IPPRODUTO" + ;
         " LEFT JOIN JPCADASTRO ON JPCADASTRO.IDCADASTRO = JPPEDIDO.PDCADASTRO" + ;
         " LEFT JOIN JPCOMISSAO ON JPCOMISSAO.CMVENDEDOR = PDVENDEDOR AND CMPRODEP = JPITEM.IEPRODEP" + ;
         " LEFT JOIN JPVENDEDOR ON JPVENDEDOR.IDVENDEDOR = JPPEDIDO.PDVENDEDOR" + ;
         " LEFT JOIN (" + ;
         " SELECT RPAD( CDCNPJ, 10, ' ' ) AS CNPJPREFIXO, CDNOME AS CNPJNOME FROM JPCADASTRO GROUP BY RPAD( CDCNPJ, 10, ' ' ) ) AS PRECNPJ" + ;
         " ON RPAD( JPCADASTRO.CDCNPJ, 10, ' ' ) = PRECNPJ.CNPJPREFIXO" + ;
         " WHERE PDCONF = 'S'" + ;
         " AND PDTRANSA IN (" + ;
         " SELECT IDTRANSA FROM JPTRANSA AS LISTAA WHERE "
      IF nOpcCompraVenda == 1
         :cSQL += " TRREACAO LIKE '%VENDA%'"
      ELSEIF nOpcCompraVenda == 2
         :cSQL += " TRREACAO LIKE '%COMPRA%'"
      ELSE
         :cSQL += " ( TRREACAO LIKE '%COMPRA%' OR TRREACAO LIKE '%VENDA%' )"
      ENDIF
      IF nOpcDevol == 2
         :cSQL += " AND TRREACAO LIKE '%DEV%'"
      ENDIF
      :cSQL += " )"
      IF nOpcVendedor == 2
         :cSQL += " AND PDVENDEDOR = " + NumberSQL( mIdVendedor )
      ENDIF
      IF nOpcCadastro == 2
         :cSQL += " AND PDCADASTRO IN (" + ;
            " SELECT IDCADASTRO FROM JPCADASTRO AS LISTA WHERE LEFT( CDCNPJ, 10 ) = " + ;
            " ( SELECT LEFT( CDCNPJ, 10 ) FROM JPCADASTRO AS ESCOLHIDO WHERE IDCADASTRO = " + NumberSQL( nIdCadastro ) + " ) )"
      ENDIF
      IF nOpcProduto == 2
         :cSQL += " AND JPITEM.IDPRODUTO = " + NumberSQL( nIdProduto )
      ENDIF
      IF nOpcProDep == 2
         :cSQL += " AND JPITEM.IEPRODEP = " + NumberSQL( nIdProDep )
      ENDIF
      :cSQL += " AND ( JPNOTFIS.NFNOTFIS IS NOT NULL OR NOT" + ;
         " JPPEDIDO.PDTRANSA IN ( SELECT IDTRANSA FROM JPTRANSA AS LISTAB WHERE TRREACAO LIKE '%N+%' OR TRREACAO LIKE '%N-%' ) )" + ;
         " AND IF( JPNOTFIS.NFNOTFIS IS NULL, PDDATEMI, NFDATEMI ) BETWEEN CAST( " + DateSQL( dDataInicial ) + " AS DATE )" + ;
         " AND CAST( " + DateSQL( dDataFinal ) + " AS DATE )"
      :cSQL += " ORDER BY " + aChaveList[ 1 ] + ", " + aChaveList[ 2 ] + ", " + aChaveList[ 3 ] + ", " + aChaveList[ 4 ]
      :Execute()
      STORE 0 To nTotQtde[ 1 ], nTotCusto[ 1 ], nTotVenda[ 1 ], nTotMargem[ 1 ], nTotComissao[ 1 ], nTotEmbalagem[ 1 ]
      RecAppend()
      RecUnlock()
      aTransacaoList := {}
      DO WHILE ! :Eof()
         Inkey()
         STORE 0 To nTotQtde[ 2 ], nTotCusto[ 2 ], nTotVenda[ 2 ], nTotMargem[ 2 ], nTotComissao[ 2 ], nTotEmbalagem[ 2 ]
         cTotChave[ 1 ] := :String( aChaveList[ 1 ] )
         RecAppend()
         REPLACE ;
            temp2->Chave1 WITH cTotChave[ 1 ], ;
            temp2->Nivel  WITH "1"
         RecUnlock()
         nTotRecNo[ 2 ] := RecNo()
         DO WHILE ! :Eof()
            Inkey()
            IF cTotChave[ 1 ] != :String( aChaveList[ 1 ] )
               EXIT
            ENDIF
            STORE 0 To nTotQtde[ 3 ], nTotCusto[ 3 ], nTotVenda[ 3 ], nTotMargem[ 3 ], nTotComissao[ 3 ], nTotEmbalagem[ 3 ]
            cTotChave[ 2 ] := :String( aChaveList[ 2 ] )
            RecAppend()
            REPLACE ;
               temp2->Chave1 WITH cTotChave[ 1 ], ;
               temp2->Chave2 WITH cTotChave[ 2 ], ;
               temp2->Nivel  WITH  "2"
            RecUnlock()
            nTotRecNo[ 3 ] := RecNo()
            DO WHILE ! :Eof()
               Inkey()
               IF cTotChave[ 1 ] != :String( aChaveList[ 1 ] )
                  EXIT
               ENDIF
               IF cTotChave[ 2 ] != :String( aChaveList[ 2 ] )
                  EXIT
               ENDIF
               STORE 0 TO nTotQtde[ 4 ], nTotCusto[ 4 ], nTotVenda[ 4 ], nTotMargem[ 4 ], nTotComissao[ 4 ], nTotEmbalagem[ 4 ]
               cTotChave[ 3 ] := :String( aChaveList[ 3 ] )
               RecAppend()
               REPLACE ;
                  temp2->Chave1 WITH cTotChave[ 1 ], ;
                  temp2->Chave2 WITH cTotChave[ 2 ], ;
                  temp2->Chave3 WITH cTotChave[ 3 ], ;
                  temp2->Nivel  WITH  "3"
               RecUnlock()
               nTotRecNo[ 4 ] := RecNo()
               DO WHILE ! :Eof()
                  Inkey()
                  IF cTotChave[ 1 ] != :String( aChaveList[ 1 ] )
                     EXIT
                  ENDIF
                  IF cTotChave[ 2 ] != :String( aChaveList[ 2 ] )
                     EXIT
                  ENDIF
                  IF cTotChave[ 3 ] != :String( aChaveList[ 3 ] )
                     EXIT
                  ENDIF
                  STORE 0 To nTotQtde[ 5 ], nTotCusto[ 5 ], nTotVenda[ 5 ], nTotMargem[ 5 ], nTotComissao[ 5 ], nTotEmbalagem[ 5 ]
                  cTotChave[ 4 ] := :String( aChaveList[ 4 ] )
                  RecAppend()
                  REPLACE ;
                     temp2->Chave1 WITH cTotChave[ 1 ], ;
                     temp2->Chave2 WITH cTotChave[ 2 ], ;
                     temp2->Chave3 WITH cTotChave[ 3 ], ;
                     temp2->Chave4 WITH cTotChave[ 4 ], ;
                     temp2->Nivel  WITH "4"
                  RecUnlock()
                  nTotRecNo[ 5 ] := RecNo()
                  DO WHILE ! :Eof()
                     Inkey()
                     IF cTotChave[ 1 ] != :String( aChaveList[ 1 ] )
                        EXIT
                     ENDIF
                     IF cTotChave[ 2 ] != :String( aChaveList[ 2 ] )
                        EXIT
                     ENDIF
                     IF cTotChave[ 3 ] != :String( aChaveList[ 3 ] )
                        EXIT
                     ENDIF
                     IF cTotChave[ 4 ] != :String( aChaveList[ 4 ] )
                        EXIT
                     ENDIF
                     nNumTransa   := hb_ASCan( aTransacaoList, { | e | e[ 1 ] == :Number( "PDTRANSA" ) } )
                     IF nNumTransa == 0
                        AAdd( aTransacaoList, { :Number( "PDTRANSA" ), 0 } )
                        nNumTransa := Len( aTransacaoList )
                     ENDIF
                     aTransacaoList[ nNumTransa, 2 ] += :Number( "IPVALNOT" )
                     RecAppend()
                     REPLACE ;
                        temp2->Chave1     WITH :String( aChaveList[ 1 ] ), ;
                        temp2->Chave2     WITH :String( aChaveList[ 2 ] ), ;
                        temp2->Chave3     WITH :String( aChaveList[ 3 ] ), ;
                        temp2->Chave4     WITH :String( aChaveList[ 4 ] ), ;
                        temp2->pdCadastro WITH StrZero( :Number( "PDCADASTRO" ), 6 ), ;
                        temp2->cdCnpj     WITH :String( "CNPJRAIZ" ), ;
                        temp2->pdVendedor WITH StrZero( :Number( "PDVENDEDOR" ), 6 ), ;
                        temp2->ipProduto  WITH StrZero( :Number( "IPPRODUTO" ), 6 ), ;
                        temp2->DescItem   WITH :String( "PRODUTO" ), ;
                        temp2->pdTransa   WITH StrZero( :Number( "PDTRANSA" ), 6 ), ;
                        temp2->NF         WITH StrZero( :Number( "NOTFIS" ), 9 ), ;
                        temp2->DatEmi     WITH :Date( "DATEMI" ), ;
                        temp2->ipQtde     WITH :Number( "FATOR" ) * :Number( "IPQTDE" ), ;
                        temp2->QtdEmb     WITH :Number( "FATOR" ) * :Number( "QTDEMBALAGEM" ), ;
                        temp2->ipValCus   WITH :Number( "FATOR" ) * :Number( "IPVALCUS" ), ;
                        temp2->ipValNot   WITH :Number( "FATOR" ) * :Number( "IPVALNOT" ), ;
                        temp2->Margem     WITH :Number( "FATOR" ) * :Number( "VMARGEM" ), ;
                        temp2->PMargem    WITH :Number( "PMARGEM" ), ;
                        temp2->ValCom     WITH :Number( "FATOR" ) * :Number( "VCOMISSAO" ), ;
                        temp2->PerCom     WITH :Number( "PCOMISSAO" ), ;
                        temp2->Nivel      WITH "5"
                     nTotQtde[ 5 ]      += :Number( "FATOR" ) * :Number( "IPQTDE" )
                     nTotEmbalagem[ 5 ] += :Number( "FATOR" ) * :Number( "QTDEMBALAGEM" )
                     nTotCusto[ 5 ]     += :Number( "FATOR" ) * :Number( "IPVALCUS" )
                     nTotVenda[ 5 ]     += :Number( "FATOR" ) * :Number( "IPVALNOT" )
                     nTotMargem[ 5 ]    += :Number( "FATOR" ) * :Number( "VMARGEM" )
                     nTotComissao[ 5 ]  += :Number( "FATOR" ) * :Number( "VCOMISSAO" )
                     :MoveNext()
                  ENDDO
                  GOTO ( nTotRecNo[ 5 ] )
                  RecLock()
                  REPLACE ;
                     temp2->ipQtde   WITH nTotQtde[ 5 ], ;
                     temp2->QtdEmb   WITH nTotEmbalagem[ 5 ], ;
                     temp2->ipValCus WITH nTotCusto[ 5 ], ;
                     temp2->ipValNot WITH nTotVenda[ 5 ], ;
                     temp2->Margem   WITH nTotMargem[ 5 ], ;
                     temp2->ValCom   WITH nTotComissao[ 5 ], ;
                     temp2->PMargem  WITH Max( Min( ( nTotVenda[ 5 ] - nTotCusto[ 5 ] ) / nTotVenda[ 5 ] * 100, 999 ), -99.9 )
                  RecUnlock()
                  nTotQtde[ 4 ]      += nTotQtde[ 5 ]
                  nTotEmbalagem[ 4 ] += nTotEmbalagem[ 5 ]
                  nTotCusto[ 4 ]     += nTotCusto[ 5 ]
                  nTotVenda[ 4 ]     += nTotVenda[ 5 ]
                  nTotMargem[ 4 ]    += nTotMargem[ 5 ]
                  nTotComissao[ 4 ]  += nTotComissao[ 5 ]
               ENDDO
               GOTO ( nTotRecNo[ 4 ] )
               RecLock()
               REPLACE ;
                  temp2->ipQtde   WITH nTotQtde[ 4 ], ;
                  temp2->QtdEmb   WIth nTotEmbalagem[ 4 ], ;
                  temp2->ipValCus WITH nTotCusto[ 4 ], ;
                  temp2->ipValNot WITH nTotVenda[ 4 ], ;
                  temp2->Margem   WITH nTotMargem[ 4 ], ;
                  temp2->ValCom   WITH nTotComissao[ 4 ], ;
                  temp2->PMargem  WITH Max( Min( ( nTotVenda[ 4 ] - nTotCusto[ 4 ] ) / nTotVenda[ 4 ] * 100, 999 ), -99.9 )
               RecUnlock()
               nTotQtde[ 3 ]      += nTotQtde[ 4 ]
               nTotEmbalagem[ 3 ] += nTotEmbalagem[ 4 ]
               nTotCusto[ 3 ]     += nTotCusto[ 4 ]
               nTotVenda[ 3 ]     += nTotVenda[ 4 ]
               nTotMargem[ 3 ]    += nTotMargem[ 4 ]
               nTotComissao[ 3 ]  += nTotComissao[ 4 ]
            ENDDO
            GOTO ( nTotRecNo[ 3 ] )
            RecLock()
            REPLACE ;
               temp2->ipQtde   WITH nTotQtde[ 3 ], ;
               temp2->QtdEmb   WITH nTotEmbalagem[ 3 ], ;
               temp2->ipValCus WITH nTotCusto[ 3 ], ;
               temp2->ipValNot WITH nTotVenda[ 3 ], ;
               temp2->Margem   WITH nTotMargem[ 3 ], ;
               temp2->ValCom   WITH nTotComissao[ 3 ], ;
               temp2->PMargem  WITH Max( Min( ( nTotVenda[ 3 ] - nTotCusto[ 3 ] ) / nTotVenda[ 3 ] * 100, 999 ), -99.9 )
            RecUnlock()
            nTotQtde[ 2 ]      += nTotQtde[ 3 ]
            nTotEmbalagem[ 2 ] += nTotEmbalagem[ 3 ]
            nTotCusto[ 2 ]     += nTotCusto[ 3 ]
            nTotVenda[ 2 ]     += nTotVenda[ 3 ]
            nTotMargem[ 2 ]    += nTotMargem[ 3 ]
            nTotComissao[ 2 ]  += nTotComissao[ 3 ]
         ENDDO
         GOTO ( nTotRecNo[ 2 ] )
         RecLock()
         REPLACE ;
            temp2->ipQtde   WITH nTotQtde[ 2 ], ;
            temp2->QtdEmb   WITH nTotEmbalagem[ 2 ], ;
            temp2->ipValCus WITH nTotCusto[ 2 ], ;
            temp2->ipValNot WITH nTotVenda[ 2 ], ;
            temp2->Margem   WITH nTotMargem[ 2 ], ;
            temp2->ValCom   WITH nTotComissao[ 2 ], ;
            temp2->PMargem  WITH Max( Min( ( nTotVenda[ 2 ] - nTotCusto[ 2 ] ) / nTotVenda[ 2 ] * 100, 999 ), -99.9 )
         RecUnlock()
         nTotQtde[ 1 ]      += nTotQtde[ 2 ]
         nTotEmbalagem[ 1 ] += nTotEmbalagem[ 2 ]
         nTotCusto[ 1 ]     += nTotCusto[ 2 ]
         nTotVenda[ 1 ]     += nTotVenda[ 2 ]
         nTotMargem[ 1 ]    += nTotMargem[ 2 ]
         nTotComissao[ 1 ]  += nTotComissao[ 2 ]
      ENDDO
      GOTO TOP
      RecLock()
      REPLACE ;
         temp2->ipQtde   WITH nTotQtde[ 1 ], ;
         temp2->QtdEmb   WITH nTotEmbalagem[ 1 ], ;
         temp2->ipValCus WITH nTotCusto[ 1 ], ;
         temp2->ipValNot WITH nTotVenda[ 1 ], ;
         temp2->Margem   WITH nTotMargem[ 1 ], ;
         temp2->ValCom   WITH nTotComissao[ 1 ], ;
         temp2->PMargem  WITH Max( Min( ( nTotVenda[ 1 ] - nTotCusto[ 1 ] ) / nTotVenda[ 1 ] * 100, 999 ), -99.9 )
      RecUnlock()
      :CloseRecordset()
   ENDWITH

   oPDF := PDFClass():New()
   oPDF:SetType( nOpcPrinterType )
   oPDF:Begin()
   nKey := 0
   oPDF:acHeader := { "COMPRAS/VENDAS NO PERIODO" }
   cTexto := "Periodo:" + iif( nOpcData == 1, "Tudo", Dtoc( dDataInicial ) + " a " + Dtoc( dDataFinal ) )
   cTexto += " Tipo:" + acTxtCompraVenda[ nOpcCompraVenda ]
   cTexto += " " + acTxtDetalhe[ nOpcDetalhe ]
   cTexto += " Depto:" + iif( nOpcProDep == 1, "Todos", NumberSQL( nIdProDep ) + "-" + Trim( AUXPRODEPClass():Descricao( nIdProDep ) ) )
   Encontra( StrZero( nIdProduto, 6 ), "jpitem", "item" )
   cTexto += " Produto:" + iif( nOpcProduto==1, "Todos", NumberSQL( nIdProduto ) + "-" + Trim( jpitem->ieDescri ) )
   cTexto += " Vendedor:" + iif( nOpcVendedor == 1, "Todos", NumberSQL( mIdVendedor ) + "-" + ADOField( "VDDESCRI", "C", "JPVENDEDOR", "IDVENDEDOR=" + NumberSQL( mIdVendedor ) ) )
   AAdd( oPDF:acHeader, cTexto )
   cTexto := Pad( aChaveList[ 1 ] + "/" + aChaveList[ 2 ] + "/" + aChaveList[ 3 ], 50 ) + ;
      " ----QTD---- --QTD.NF.-- " + Iif( nOpcCusto == 2, "---VL.CUSTO--- ", "" ) + ;
      "---VL.PEDIDO-- " + Iif( nOpcCusto == 2, "---VL.MARGEM-- %MARGEM ", "" ) + "    COMISSAO/%"
   AAdd( oPDF:acHeader, cTexto )
   oPDF:PageHeader()
   STORE Chr(205) TO cTotChave[ 1 ], cTotChave[ 2 ], cTotChave[ 3 ]
   GOTO TOP
   SKIP // Primeiro registro total
   DO WHILE nKey != K_ESC .AND. ! Eof()
      GrafProc()
      nKey := Inkey()
      IF temp2->Nivel > Str( nOpcDetalhe, 1 )
         SKIP
         LOOP
      ENDIF
      oPDF:MaxRowTest()
      cTxt := ""
      IF temp2->Nivel == "1" // cTotChave[ 1 ] != temp2->Chave1
         oPDF:nRow += 1
         oPDF:MaxRowTest()
         cTxt := Pad( temp2->Chave1, 40 )
         cTotChave[ 1 ] := temp2->Chave1
         cTotChave[ 2 ] := Chr(205)
         cTotChave[ 3 ] := Chr(205)
         cTotChave[ 4 ] := Chr(205)
      ELSEIF temp2->Nivel == "2" // cTotChave[ 2 ] != temp2->Chave2 .AND. nOpcDetalhe > 1
         oPDF:MaxRowTest()
         cTotChave[ 2 ] := Pad( temp2->Chave2, 40 )
         cTxt := Space(2) + temp2->Chave2
         cTotChave[ 3 ] := Chr(205)
         cTotChave[ 4 ] := Chr(205)
      ELSEIF temp2->Nivel == "3" // cTotChave[ 3 ] != temp2->Chave3 .AND. nOpcDetalhe > 2
         cTotChave[ 3 ] := temp2->Chave3
         oPDF:MaxRowTest()
         cTxt := Space(4) + Pad( temp2->Chave3, 40 )
         cTotChave[ 4 ] := Chr(205)
      ELSEIF temp2->Nivel == "4" // cTotChave[ 4 ] != temp2->Chave4 .AND. nOpcDetalhe > 3
         cTotChave[ 4 ] := temp2->Chave4
         oPDF:MaxRowTest()
         cTxt := Space(6) + Pad( temp2->Chave4, 40 )
      ELSEIF temp2->Nivel == "5"
         cTxt := Space(22) + temp2->Nf + " " + Dtoc( temp2->DatEmi )
      ENDIF
      cTxt := Pad( cTxt, 50 )
      cTxt += " " + Transform( temp2->QtdEmb, PicVal(9) )
      cTxt += " " + Transform( temp2->ipQtde, PicVal(9) )
      IF nOpcCusto == 2
         cTxt += " " + Transform( temp2->ipValCus, PicVal(11,2) )
      ENDIF
      cTxt += " " + Transform( temp2->ipValNot, PicVal(11,2) )
      IF temp2->Nivel < "3"
         oPDF:DrawZebrado(2)
      ELSE
         oPDF:DrawZebrado(1)
      ENDIF
      IF nOpcCusto == 2
         cTxt += " " + Transform( temp2->Margem, PicVal(11,2) )
         cTxt += " " + Transform( temp2->PMargem, "@E 999.9" )
      ENDIF
      IF nOpcComComissao == 2
         cTxt += " " + Transform( temp2->ValCom, PicVal( 8, 2 ) )
         cTxt += " " + "(" + Transform( temp2->PerCom, "@Z 999.999" ) + ")"
      ENDIF
      oPDF:DrawText( oPDF:nRow, 0, cTxt )
      IF nOpcDetalhe == 5 .AND. ! Empty( temp2->Obs )
         oPDF:nRow += 1
         cTxt := " " + temp2->Obs
         cTxt := Padl( cTxt, oPDF:MaxCol() )
         oPDF:DrawText( oPDF:nRow, 0, cTxt )
      ELSE
      ENDIF
      oPDF:nRow += 1
      SKIP
   ENDDO
   GOTO TOP
   oPDF:nRow += 2
   oPDF:MaxRowTest()
   cTxt := Pad( "***TOTAIS***", 50 )
   cTxt += " " + Transform( temp2->QtdEmb, PicVal(9) )
   cTxt += " " + Transform( temp2->ipQtde, PicVal(9) )
   IF nOpcCusto == 2
      cTxt += " " + Transform( temp2->ipValCus, PicVal(11,2) )
   ENDIF
   cTxt += " " + Transform( temp2->ipValNot, PicVal(11,2) )
   IF nOpcCusto == 2
      cTxt += " " + Transform( temp2->Margem, PicVal(11,2) )
      cTxt += " " + Transform( temp2->PMargem, "@E 999.9" )
   ENDIF
   cTxt += " " + Transform( temp2->ValCom, PicVal(8,2) )
   oPDF:DrawText( oPDF:nRow, 0, cTxt )
   IF nOpcAnalise == 2
      oPDF:nRow += 2
      oPDF:MaxRowTest()
      FOR nCont = 1 TO Len( aTransacaoList )
         oPDF:MaxRowTest()
         cTxt := Str( aTransacaoList[ nCont, 1 ], 6 )
         cTxt += " " + Transform( aTransacaoList[ nCont, 2 ], PicVal( 14, 2 ) )
         cTxt += " " + DescricaoJPTRANSA( aTransacaoList[ nCont, 1 ] )
         oPDF:DrawText( oPDF:nRow, 0, cTxt )
         oPDF:nRow += 1
      NEXT
   ENDIF
   SELECT temp2
   USE
   FOR EACH oFile IN mTmpFile
      fErase( oFile )
   NEXT
   oPDF:End()

   RETURN NIL

[JoséQuintas]

Pois é...
Com isso só falta um fonte, mas.... é relacionado a um DBF que ainda só está em DBF.
Agora avaliar se faço uma alteração quebra-galho, ou se já começo a eliminação de mais outro DBF.

O quebra-galho pode ser interessante, porque esse é o último fonte dependente de jpcadastro.dbf

[JoséQuintas]

Pois é... complicou mais.... talvez....

Esse último fonte é da listagem de tabela de preços diferenciados.
Essa tabela está em DBF.
E ela tem um histórico relacionado, já em MySQL.

A chave é cliente + produto + prazo, inclusive no histórico.
Ficaria mais interessante definir uma ID pra isso, e já vincular essa ID também no histórico, além de ser chave pra MySQL.
Pensar mais... agora trata-se de migrar outro DBF pra MySQL, e alterar uma base MySQL já existente.
A alteração desse vínculo fica até mais fácil em MySQL, porque poderia atualizar o ID do histórico fazendo apenas um relacionamento entre os dois.

É assim:

no preço é cliente + produto + prazo
no histórico é cliente + produto + prazo + data

Colocando um ID no preço, o histórico seria ID + data, bem mais simplificado, só por definir uma ID.

É... talvez melhor ficar no quebra-galho kkkkk

[JoséQuintas]

Aqui é apenas comentário.

28/06/2020 06:31 6.544.816 jpa.exe
05/07/2020 09:48 6.536.192 jpa.exe

Mesmo entrando novas rotinas de conversão/atualização, o EXE está um pouco menor.
É apenas comentário, porque isso nem importa.

Com certeza, quando apagar tudo que é conversão/atualização, vai ficar menor mesmo.
Mas nem espero grandes mudanças de tamanho, porque a maior parte se refere a ícones/resources.

Curiosidade de anteriores, incluindo versão CLIPPER e console puro.

16/09/2002 14:31 1.012.864 JPA2002.EXE
08/09/2006 20:32 1.030.208 JPA2004.EXE
27/03/2011 16:24 1.323.392 jpa2010.exe
16/04/2013 20:29 2.149.888 jpa2013.exe
14/04/2015 10:08 1.666.048 JPA2015.EXE
14/02/2018 19:51 2.419.000 jpa2018.exe
10/03/2020 20:34 6.750.512 jpa2020.exe
02/07/2020 07:30 6.544.816 JPA.EXE

[JoséQuintas]

Código: Selecionar todos

03/03/2020  02:33         1.254.539 jpcidade.dbf
09/07/2020  19:02         1.376.894 jpitem.DBF
09/07/2020  19:00        11.028.454 jpcadastro.DBF
09/07/2020  21:18        16.377.672 jpbancario.dbf
              20 arquivo(s)     31.322.316 bytes

Tô eliminando tudo, daqui a pouco só vai sobrar o contábil.
Esse vou remodelar antes de passar pra MySQL.

[JoséQuintas]

Não pensei que ia dar tanto trabalho ficar apagando fonte.

Código: Selecionar todos

09/07/2020  21:18           502.533 jppreco.DBF
03/03/2020  02:33         1.254.539 jpcidade.dbf
09/07/2020  19:02         1.376.894 jpitem.DBF
09/07/2020  21:18        16.377.672 jpbancario.dbf
              19 arquivo(s)     20.294.143 bytes

Menos outro.

O que fui deixando pra depois.... pois é... em breve não tem depois....
A primeira vista, esse bancário vai dar trabalho, porque ainda não sei como vou fazer certas coisas em SQL.

[JoséQuintas]

O fonte de agora é daqueles....

fonte Harbour, pra gerar VBScript pra Html, e mais o ADO.... rs

Isso junta PRG, HTML, VBScript, ADO, tudo no mesmo fonte.... aff

E isso, só pra não apagar o fonte fora de uso.

[JoséQuintas]

Tem coisa no SQL que pode ser considerada chata ou não, depende do ponto de vista.

Com o DBF posicionado, bastava verificar isto:
" DE ICMS " $ jpitem->ieDescri

mas com SQL:

Código: Selecionar todos

STATIC FUNCTION IsComplementoICMS( nIdNotFis )

   LOCAL lSim := .F.
   LOCAL cnSQL := ADOClass():New( AppConexao() )
   
   WITH OBJECT cnSQL
      :cSQL := "SELECT COUNT(*) AS QTD" + ;
         " FROM JPNOTFIS" + ;
         " LEFT JOIN JPPEDIDO ON JPPEDIDO.IDPEDIDO = JPNOTFIS.NFPEDIDO" + ;
         " LEFT JOIN JPITPED ON JPITPED.IPPEDIDO = JPPEDIDO.IDPEDIDO" + ;
         " LEFT JOIN JPITEM ON JPITEM.IDPRODUTO = JPITPED.IPPRODUTO" + ;
         " WHERE JPNOTFIS.IDNOTFIS = " + NumberSQL( nIdNotFis ) + ;
         " AND JPITEM.IEDESCRI LIKE '% DE ICMS %'"
      :Execute()
      lSim := :Number( "QTD" ) != 0
      :CloseRecordset()
   ENDWITH
   
   RETURN lSim

Olhando como pessimista: muito fonte pra uma coisa que era simples
Olhando como otimista: nenhum arquivo aberto, apenas está perguntando pro servidor.

Comando complicado? só lembrar do dBase

- faz o relacionamento entre os arquivos, ao invés de SET RELATION é JOIN
- dá o filtro, ao invés de FOR xxxx é WHERE xxxx
- A diferença no SQL é que tudo vém, não apenas o registro atual de JPNOTFIS, vém todos os produtos relacionados

O comando relaciona nota fiscal com pedidos, pedidos com produtos de pedido, produto de pedido com o cadastro de produtos.
A intenção aqui é trabalhar com a descrição de todos os produtos que estão na nota/pedido
O SELECT vai considerar todos os produtos do pedido que gerou a nota fiscal (de cada nota, se fossem várias).
O filtro vai considerar apenas descrição contendo " DE ICMS " na descrição e somente da nota fiscal indicada.
O retorno é a variável QTD que contém a quantidade de registros.
É um comando grande pra só retornar um número, mas tem muita tabela envolvida.
Se o número for diferente de zero, quer dizer que encontrou.

Não importa o tamanho do comando, é rápido, e pela rede só passa esse número do resultado, o que não ocupa tempo de rede ou de terminal.

Apesar de posicionado, em DBF ser prático, se fosse fazer inteiro em DBF, teria USE/SELECT/SEEK/DO WHILE/etc,
Desse jeito, não precisa estar aberto, não tem erro de usar índice errado, índice corrompido, etc. etc., sempre funciona.
Como eu disse, dá pra olhar pelo lado otimista e pessimista.
Prefiro pelo lado otimista, de que sempre funciona, é rápido, e não precisa se preocupar com índices, arquivos abertos, etc.

Estou usando isso na geração de XML da nota fiscal, na parte de cobrança.
Também poderia pegar essa informação durante a geração do bloco produtos, o que eliminaria essa rotina desse bloco.
Ou poderia ter a nota inteira numa variável, numa classe guardando o conteúdo da nota... seria válido também.

[JoséQuintas]

Agora mudei este, de reajuste de preços.

Código: Selecionar todos

      Mensagem( "Aguarde, aplicando reajuste" )
      SELECT jppreco
      GOTO TOP
      DO WHILE ! Eof()
         IF Val( jppreco->pcProduto ) != nIdProduto
            SKIP
            LOOP
         ENDIF
         IF Val( jppreco->pcStatus ) != 1
            SKIP
            LOOP
         ENDIF
         IF jppreco->pcReajuste != mpcReajuste
            SKIP
            LOOP
         ENDIF
         RecLock()
         IF mTipoReajuste == "P"
            REPLACE ;
               jppreco->pcValor  WITH jppreco->pcValor + ( jppreco->pcValor * mPercent / 100 ), ;
               jppreco->pcInfAlt WITH LogInfo()
         ELSE
            REPLACE ;
               jppreco->pcValor  WITH jppreco->pcValor + mPercent, ;
               jppreco->pcInfAlt WITH LogInfo()
         ENDIF
         RecUnlock()
         WITH OBJECT cnSQL
            :QueryCreate()
            :QueryAdd( "PHCADASTRO",  jppreco->pcCadastro )
            :QueryAdd( "PHPRODUTO",   jppreco->pcProduto )
            :QueryAdd( "PHFORPAG", jppreco->pcForPag )
            :QueryAdd( "PHVALOR",  jppreco->pcValor )
            :QueryAdd( "PHOBS",    "REAJ." + iif( mTipoReajuste == "P", "PERCENTUAL", "VALOR" ) + " " + iif( mPercent > 0, "+", "" ) + Ltrim( Str( mPercent ) ) )
            :QueryAdd( "PHDATA",   mData )
            :QueryAdd( "PHHORA",   iif( mData == Date(), Time(), "" ) )
            :QueryAdd( "PHINFINC", jppreco->pcInfAlt )
            :QueryExecuteInsert( "JPPREHIS" )
         ENDWITH
         SELECT jppreco
         SKIP
      ENDDO
      MsgExclamation( "Fim do reajuste!" )
   ENDDO

mudei pra isto:

Código: Selecionar todos

      Mensagem( "Aguarde, aplicando reajuste" )
      WITH OBJECT cnSQL
         nMultiplica := iif( cTipoReajuste == "P", ( 100 + nPercent ) / 100, 1 )
         nSoma       := iif( cTipoReajuste == "P", 0, nPercent )
         cLogInfo    := LogInfo()
         cTime       := Time()
         :cSQL := "UPDATE JPPRECO" + ;
            " SET PCVALOR = PCVALOR * " + NumberSQL( nMultiplica ) + " + " + NumberSQL( nSoma ) + "," + ;
            " PCINFALT = " + StringSQL( cLogInfo ) + ;
            " WHERE PCPRODUTO = " + NumberSQL( nIdProduto ) + " AND PCSTATUS = 1" + ;
            " AND PCREAJUSTE = " + StringSQL( mpcReajuste )
         :ExecuteCmd()
         :cSQL := "INSERT INTO JPPREHIS" + ;
            " ( PHCADASTRO, PHPRODUTO, PHFORPAG, PHVALOR, PHREAJUSTE, PHOBS, PHDATA, PHHORA, PHINFINC )" + ;
            " SELECT PCCADASTRO, PCPRODUTO, PCFORPAG, PCVALOR, PCREAJUSTE, " + ;
               StringSQL( "REAJ." + iif( cTipoReajuste == "P", "PERCENTUAL", "VALOR" ) + " " + ;
                  iif( nPercent > 0, "+", "" ) + NumberSQL( nPercent ) ) + " AS OBS," + ;
               DateSQL( mData ) + " AS DATA, " + StringSQL( cTime ) + " AS HORA, " + StringSQL( cLogInfo ) + " AS INFINC FROM JPPRECO" + ;
               " WHERE PCINFALT = " + StringSQL( cLogInfo )
         :ExecuteCmd()
      ENDWITH
      MsgExclamation( "Fim do reajuste!" )
   ENDDO

Só sei que finalmente não deu erro, mas não sei se deu certo.
É que a parte de consulta deu erro porque ainda precisa do DBF kkkk
Só vou saber se deu certo depois.

Decidi acabar com o jppreco.dbf de vez, porque usa em poucos fontes.

[JoséQuintas]

Comentario do fonte anterior:

O reajuste pode ser por percentual ou valor.
No fonte anterior eu fazia calculo separado: ou vezes o percentual ou soma o valor.

No SQL usei uma forma simples de aplicar os dois de uma vez, VALOR * percentual + soma

Se NÃO é por percentual, é deixar percentual 1, multiplicando por 1 não altera o valor
Se NÃO é por soma, é deixar valor 0, se somar 0 não altera valor.
Uma mesma fórmula atendendo os dois casos de uma vez.

[JoséQuintas]

Lembrei de uma coisa:

O que acontece se o cálculo tiver mais decimais do que a tabela?

Na dúvida, pra evitar erro, coloquei ROUND() na fórmula.