Como fazer uma barra de progresso com percentual

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:

Exemplo da tela de processo com percentual

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.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

4 Responses

  1. Rafael Achôa disse:

    O hómi é bão demaiss!
    Parabéns Atílio, sempre subindo o nível da customização em ADVPL.

  2. Bruno Romeiro Comin disse:

    Muito bom, em alguns casos calculamos 35% de performance no relatório!
    Obrigado por sempre contribuir com a comunidade…

Deixe uma resposta