No artigo de hoje vamos mostrar uma barra de progresso (ou processo) com percentual.
Esse artigo foi feito com base em uma lógica do grande Bruno Comin ( LinkedIn ).
Basicamente, essa rotina serve para substituir o incremento padrão do IncProc, que às vezes pode parecer lento e às vezes afetando a performance.
Então para isso, é usado no lugar o MsNewProcess, e na segunda régua é feito uma tratativa especial, através de duas funções:
- zProcRegua: É informado o objeto de processamento, o total de registros e percentual que a cada incremento irá pular (por exemplo, se for 200 registros, a cada 10% ele irá pular a cada 20 registros)
- zIncProc: Função para incrementar a régua de processamento, recebendo o objeto, a mensagem, e ser irá exibir o percentual na barra (com isso, ao acionar essa função, se o percentual bater, a régua será incrementada)
Abaixo um print de uma rotina:
Abaixo o código fonte completo:
//Bibliotecas #Include "TOTVS.ch" //Variável que irá conter o total de registros que serão processados Static nTotRegua := 0 Static nAtuRegua := 0 Static nPerRegua := 0 Static aRegua1 := {.F., .F., .F.} /*/{Protheus.doc} User Function zProcRegua Função para definir o total da Régua do Processa (no lugar do ProcRegua) @type Function @author Bruno Comin (adaptações por Atilio) @since 04/01/2022 @version version @param oProcess, Object, Objeto de impressão criado via MsNewProcess @param nTotal, Numeric, Total de registros que serão processados @param nPercent, Numeric, Percentual que a régua deverá ser incrementada @example //Pega o total de registros DbSelectArea("QRYAUX") Count To nTotal QRYAUX->(DbGoTop()) //Define a régua u_zProcRegua(oProcess, nTotal, 20) /*/ User Function zProcRegua(oProcess, nTotal, nPercent) Local aArea := FWGetArea() Default nTotal := 0 Default nPercent := 2 If ValType(oProcess) != "U" //Divide o percentual por 100 nPercent := nPercent / 100 //Define as variáveis estáticas (que irão existir na memória somente nesse prw) nTotRegua := nTotal nAtuRegua := 0 //Define a quantidade de registros a cada pulo da régua conforme o % (caso não haja, define como 1) nPerRegua := Round(nTotRegua * nPercent, 0) If Empty(nPerRegua) nPerRegua := 1 EndIf //Agora seta o tamanho da régua (a primeira terá 3 pulos a cada 30%, a segunda terá "n" pulos conforme o percentual) aRegua1 := {.F., .F., .F.} oProcess:SetRegua1(Len(aRegua1)) oProcess:SetRegua2(nPercent) EndIf FWRestArea(aArea) Return /*/{Protheus.doc} User Function zIncProc Função para incrementar a régua do Processa (no lugar do IncProc) @type Function @author Bruno Comin (adaptações por Atilio) @since 04/01/2022 @version version @param oProcess, Object, Objeto de impressão criado via MsNewProcess @param cMessage, Character, Mensagem que será exibida na régua @param lShow, Logic, Define se irá exibir a quantidade de registros na régua @example //Percorre a temporária While ! QRYAUX->(EoF()) //Incrementa a régua u_zIncProc(oProcess, "Produto " + QRYAUX->B1_COD) //Faz o restante da lógica QRYAUX->(DbSkip()) EndDo /*/ User Function zIncProc(oProcess, cMessage, lShow) Local aArea := FWGetArea() Local nPercAtu := 0 Default cMessage := "" Default lShow := .T. If ValType(oProcess) != "U" //Adiciona 1 na régua atual nAtuRegua += 1 //Se o registro atual fizer parte do 2%, ai sim irá incrementar a régua // (se for a cada 2, será 2%, 4%, 6%, etc) // (se for a cada 5, será 5%, 10%, 15%, etc) // (se for a cada 10, será 10%, 20%, 30%, etc) // e assim por diante If Mod(nAtuRegua, nPerRegua) == 0 //Pega o percentual atual nPercAtu := NoRound((nAtuRegua * 100) / nTotRegua, 0) //Se for exibir a quantidade de registros If lShow cMessage := "[" + cValToChar(nAtuRegua) + " de " + cValToChar(nTotRegua) + "] " + cMessage EndIf cMessage := "[" + cValToChar(nPercAtu) + "%]" + cMessage //Incrementa a segunda régua, mostrando a mensagem oProcess:IncRegua2(cMessage) //Se for maior que 30% e ainda não ter incrementado a primeira régua If nPercAtu >= 30 .And. ! aRegua1[1] oProcess:IncRegua1("Processando...") aRegua1[1] := .T. EndIf //Se for maior que 60% e ainda não ter incrementado a primeira régua If nPercAtu >= 60 .And. ! aRegua1[2] oProcess:IncRegua1("Processando...") aRegua1[2] := .T. EndIf //Se for maior que 90% e ainda não ter incrementado a primeira régua If nPercAtu >= 90 .And. ! aRegua1[3] oProcess:IncRegua1("Processando...") aRegua1[3] := .T. EndIf EndIf EndIf FWRestArea(aArea) Return
Eu peguei o exemplo do relatório completo zebrado (disponível nesse link), e adaptei com essa régua:
//Bibliotecas #Include "TOTVS.ch" #Include "TopConn.ch" #Include "RPTDef.ch" #Include "FWPrintSetup.ch" //Alinhamentos #Define PAD_LEFT 0 #Define PAD_RIGHT 1 #Define PAD_CENTER 2 Static nCorCinza := RGB(110, 110, 110) Static nCorAzul := RGB(193, 231, 253) /*/{Protheus.doc} zZebra Listagem de produtos, com cor de fundo alterada (zebrada) @author Atilio @since 03/06/2021 @version 1.0 @type function /*/ User Function zZebra() Local aPergs := {} Private cProdDe := Space(TamSX3("B1_COD")[1]) Private cProdAt := StrTran(cProdDe, " ", "Z") Private oProcess //Monta os parâmetros da tela aAdd(aPergs, {1, "Produto De", cProdDe, "@!", ".T.", "SB1", ".T.", 90, .F.}) aAdd(aPergs, {1, "Produto Até", cProdAt, "@!", ".T.", "SB1", ".T.", 90, .T.}) //Se a pergunta for confirmada If ParamBox(aPergs, "Informe os parâmetros", , , , , , , , , .F., .F.) cProdDe := MV_PAR01 cProdAt := MV_PAR02 //Função para gerar o relatório oProcess := MsNewProcess():New({|| fImprime() }, "Processando...", "Aguarde...", .T.) oProcess:Activate() EndIf Return /*/{Protheus.doc} fImprime Funcao que gera o PDF Automaticamente @author Atilio @since 03/06/2021 @version 1.0 /*/ Static Function fImprime() Local aArea := GetArea() Local nTotAux := 0 Local nAtuAux := 0 Local cQryAux Local cArquivo := "zZebra_"+RetCodUsr()+"_" + dToS(Date()) + "_" + StrTran(Time(), ':', '-') + ".pdf" Private oPrintPvt Private oBrushAzul := TBRUSH():New(,nCorAzul) Private cHoraEx := Time() Private nPagAtu := 1 //Linhas e colunas Private nLinAtu := 0 Private nLinFin := 580 Private nColIni := 010 Private nColFin := 815 Private nEspCol := (nColFin-(nColIni+150))/13 Private nColMeio := (nColFin-nColIni)/2 //Colunas dos relatorio Private nColProd := nColIni Private nColDesc := nColIni + 050 Private nColUnid := nColFin - 425 Private nColTipo := nColFin - 340 Private nColBarr := nColFin - 200 //Declarando as fontes Private cNomeFont := "Arial" Private oFontDet := TFont():New(cNomeFont, 9, -11, .T., .F., 5, .T., 5, .T., .F.) Private oFontDetN := TFont():New(cNomeFont, 9, -13, .T., .T., 5, .T., 5, .T., .F.) Private oFontRod := TFont():New(cNomeFont, 9, -8, .T., .F., 5, .T., 5, .T., .F.) Private oFontMin := TFont():New(cNomeFont, 9, -7, .T., .F., 5, .T., 5, .T., .F.) Private oFontMinN := TFont():New(cNomeFont, 9, -7, .T., .T., 5, .T., 5, .T., .F.) Private oFontTit := TFont():New(cNomeFont, 9, -15, .T., .T., 5, .T., 5, .T., .F.) //Monta a consulta de dados cQryAux := "" cQryAux += " SELECT " + CRLF cQryAux += " B1_COD, " + CRLF cQryAux += " B1_DESC, " + CRLF cQryAux += " B1_UM, " + CRLF cQryAux += " B1_TIPO, " + CRLF cQryAux += " B1_CODBAR " + CRLF cQryAux += " FROM " + CRLF cQryAux += " " + RetSQLName("SB1") + " SB1 " + CRLF cQryAux += " WHERE " + CRLF cQryAux += " B1_FILIAL = '" + FWxFilial("SB1") + "' " + CRLF cQryAux += " AND B1_MSBLQL != '1' " + CRLF cQryAux += " AND B1_COD >= '" + cProdDe + "' " + CRLF cQryAux += " AND B1_COD <= '" + cProdAt + "' " + CRLF cQryAux += " AND SB1.D_E_L_E_T_ = ' ' " + CRLF cQryAux += " ORDER BY " + CRLF cQryAux += " B1_COD " + CRLF TCQuery cQryAux New Alias "QRY_AUX" //Define o tamanho da régua Count to nTotAux u_zProcRegua(oProcess, nTotAux, 5) QRY_AUX->(DbGoTop()) //Somente se tiver dados If ! QRY_AUX->(EoF()) //Criando o objeto de impressao oPrintPvt := FWMSPrinter():New(cArquivo, IMP_PDF, .F., , .T., , @oPrintPvt, , , , ,.T.) oPrintPvt:cPathPDF := GetTempPath() oPrintPvt:SetResolution(72) oPrintPvt:SetLandscape() oPrintPvt:SetPaperSize(DMPAPER_A4) oPrintPvt:SetMargin(0, 0, 0, 0) //Imprime os dados fImpCab() While ! QRY_AUX->(EoF()) nAtuAux++ u_zIncProc(oProcess, "Imprimindo produto " + QRY_AUX->B1_COD) //Se atingiu o limite, quebra de pagina fQuebra() //Faz o zebrado ao fundo If nAtuAux % 2 == 0 oPrintPvt:FillRect({nLinAtu - 2, nColIni, nLinAtu + 12, nColFin}, oBrushAzul) EndIf //Imprime a linha atual oPrintPvt:SayAlign(nLinAtu, nColProd, QRY_AUX->B1_COD, oFontDet, (nColDesc - nColProd), 10, , PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu, nColDesc, QRY_AUX->B1_DESC, oFontDet, (nColUnid - nColDesc), 10, , PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu, nColUnid, QRY_AUX->B1_UM, oFontDet, (nColTipo - nColUnid), 10, , PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu, nColTipo, QRY_AUX->B1_TIPO, oFontDet, (nColBarr - nColTipo), 10, , PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu, nColBarr, QRY_AUX->B1_CODBAR, oFontDet, (nColFin - nColBarr), 10, , PAD_LEFT, ) nLinAtu += 15 oPrintPvt:Line(nLinAtu-3, nColIni, nLinAtu-3, nColFin, nCorCinza) //Se atingiu o limite, quebra de pagina fQuebra() QRY_AUX->(DbSkip()) EndDo fImpRod() oPrintPvt:Preview() Else MsgStop("Não foi encontrado informações com os parâmetros informados!", "Atenção") EndIf QRY_AUX->(DbCloseArea()) RestArea(aArea) Return /*---------------------------------------------------------------------* | Func: fImpCab | | Desc: Funcao que imprime o cabecalho | *---------------------------------------------------------------------*/ Static Function fImpCab() Local cTexto := "" Local nLinCab := 015 //Iniciando Pagina oPrintPvt:StartPage() //Cabecalho cTexto := "Listagem de Produtos" oPrintPvt:SayAlign(nLinCab, nColMeio-200, cTexto, oFontTit, 400, 20, , PAD_CENTER, ) oPrintPvt:SayAlign(nLinCab - 03, nColFin-300, "De: " + cProdDe, oFontDetN, 300, 20, , PAD_RIGHT, ) oPrintPvt:SayAlign(nLinCab + 07, nColFin-300, "Até: " + cProdAt, oFontDetN, 300, 20, , PAD_RIGHT, ) //Linha Separatoria nLinCab += 020 oPrintPvt:Line(nLinCab, nColIni, nLinCab, nColFin) //Atualizando a linha inicial do relatorio nLinAtu := nLinCab + 5 oPrintPvt:SayAlign(nLinAtu+00, nColProd, "Código", oFontMin, (nColDesc - nColProd), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+10, nColProd, "Produto", oFontMin, (nColDesc - nColProd), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+05, nColDesc, "Descrição", oFontMin, (nColUnid - nColDesc), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+00, nColUnid, "Unidade de", oFontMin, (nColTipo - nColUnid), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+10, nColUnid, "Medida", oFontMin, (nColTipo - nColUnid), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+05, nColTipo, "Tipo", oFontMin, (nColBarr - nColTipo), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+00, nColBarr, "Código de", oFontMin, (nColFin - nColBarr), 10, nCorCinza, PAD_LEFT, ) oPrintPvt:SayAlign(nLinAtu+10, nColBarr, "Barras", oFontMin, (nColFin - nColBarr), 10, nCorCinza, PAD_LEFT, ) nLinAtu += 25 Return /*---------------------------------------------------------------------* | Func: fImpRod | | Desc: Funcao que imprime o rodape | *---------------------------------------------------------------------*/ Static Function fImpRod() Local nLinRod:= nLinFin Local cTexto := '' //Linha Separatoria oPrintPvt:Line(nLinRod, nColIni, nLinRod, nColFin) nLinRod += 3 //Dados da Esquerda cTexto := dToC(dDataBase) + " " + cHoraEx + " " + FunName() + " (zZebra) " + UsrRetName(RetCodUsr()) oPrintPvt:SayAlign(nLinRod, nColIni, cTexto, oFontRod, 500, 10, , PAD_LEFT, ) //Direita cTexto := "Pagina "+cValToChar(nPagAtu) oPrintPvt:SayAlign(nLinRod, nColFin-40, cTexto, oFontRod, 040, 10, , PAD_RIGHT, ) //Finalizando a pagina e somando mais um oPrintPvt:EndPage() nPagAtu++ Return Static Function fQuebra() If nLinAtu >= nLinFin-10 fImpRod() fImpCab() EndIf Return
Bom pessoal, por hoje é só.
Abraços e até a próxima.
O hómi é bão demaiss!
Parabéns Atílio, sempre subindo o nível da customização em ADVPL.
Ahooo Rafa, muito obrigado pelo comentário man.
Muita bondade e generosidade sua, nesse artigo tive uma ajuda do Brunão.
Grande abraço man.
Muito bom, em alguns casos calculamos 35% de performance no relatório!
Obrigado por sempre contribuir com a comunidade…
Grande Brunão.
Obrigado pelo comentário e feedback jovem.
Abraços.