Como fazer barras de processamento em AdvPL

Hoje irei mostrar como criar barras de processamento via AdvPL.

MsAguarde

Exemplo de MsAguarde

Função de progresso, que muda apenas o texto, conforme a função MsProcTxt().

//Exemplo de Chamada
MsAguarde({|| fExemplo1()}, "Aguarde...", "Processando Registros...")
 
...
 
/*-----------------------------------------------------------*
 | Func.: fExemplo1                                          |
 | Desc.: Exemplo utilizando MsAguarde                       |
 *-----------------------------------------------------------*/
 
Static Function fExemplo1()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        MsProcTxt("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return

MsNewProcess

Exemplo de MsNewProcess

Régua dupla de processamento, para manipular pode ser usado os métodos SetRegua1(), IncRegua1(), SetRegua2() e IncRegua2().

//Exemplo de Chamada
oProcess := MsNewProcess():New({|| fExemplo2(oProcess)}, "Processando...", "Aguarde...", .T.)
oProcess:Activate()
 
...
 
/*-----------------------------------------------------------*
 | Func.: fExemplo2                                          |
 | Desc.: Exemplo utilizando MsNewProcess                    |
 *-----------------------------------------------------------*/
 
Static Function fExemplo2(oObj)
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
    Local nAtu2  := 0
    Local nTot2  := 90
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    oObj:SetRegua1(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        oObj:IncRegua1("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        //Incrementando a régua 2
        oObj:SetRegua2(nTot2)
        For nAtu2 := 1 To nTot2
            oObj:IncRegua2("Posição " + cValToChar(nAtu2) + " de " + cValToChar(nTot2) + "...")
        Next
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return

MsgRun

Exemplo de MsgRun

Barra usada para execução de blocos de código, como DbEval e aEval.

<br>
MsgRun("Lendo tabela...", "Título", {|| QRY_AUX->(DbEval({|x| nTotal++})) })

RptStatus

Exemplo de RptStatus

Régua de processamento, sem a possibilidade de alterar o texto, também pode ser usada via Coletor. As funções que manipulam são SetRegua() e IncRegua().

//Exemplo de chamada
RptStatus({|| fExemplo4()}, "Aguarde...", "Executando rotina...")
 
...
 
/*-----------------------------------------------------------*
 | Func.: fExemplo4                                          |
 | Desc.: Exemplo utilizando RptStatus                       |
 *-----------------------------------------------------------*/
 
Static Function fExemplo4()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    SetRegua(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        IncRegua()
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return

Processa

Exemplo de Processa

Barra que pode ter tamanho setado, e também alterado o texto. Para manipular é ProcRegua() e IncProc().

//Exemplo de Chamada
Processa({|| fExemplo5()}, "Filtrando...")
 
...
 
/*-----------------------------------------------------------*
 | Func.: fExemplo5                                          |
 | Desc.: Exemplo utilizando Processa                        |
 *-----------------------------------------------------------*/
 
Static Function fExemplo5()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    ProcRegua(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        IncProc("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return

Exemplo completo

Tela usando barras de progresso

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"
 
/*/{Protheus.doc} zTstBar
Função de exemplo de barras de processamento em AdvPL
@author Atilio
@since 28/10/2018
@version 1.0
@type function
@example u_zTstBar()
/*/
 
User Function zTstBar()
    Local aArea      := GetArea()
    Local lContinua  := .T.
    Local nTipoRegua := 0
    Local oProcess
    Private cQryAux  := ""
     
    //Monta a consulta de grupo de produtos
    cQryAux := " SELECT "                          + CRLF
    cQryAux += "     BM_GRUPO, "                    + CRLF
    cQryAux += "     BM_DESC "                      + CRLF
    cQryAux += " FROM "                            + CRLF
    cQryAux += "     SBM010 SBM "                   + CRLF
    cQryAux += " WHERE "                           + CRLF
    cQryAux += "     BM_FILIAL = ' ' "              + CRLF
    cQryAux += "     AND SBM.D_E_L_E_T_ = ' ' "     + CRLF
     
    //Enquanto houver testes
    While lContinua
        nTipoRegua := 0
        nTipoRegua := Aviso('Atenção', 'Qual tipo gostaria de Testar?', {'MsAguarde', 'MsNewProcess', 'MsgRun', 'RptStatus', 'Processa'}, 2)
         
        //Conforme botão selecionado, monta a régua
        If nTipoRegua == 1
            MsAguarde({|| fExemplo1()}, "Aguarde...", "Processando Registros...")
             
        ElseIf nTipoRegua == 2
            oProcess := MsNewProcess():New({|| fExemplo2(oProcess)}, "Processando...", "Aguarde...", .T.)
            oProcess:Activate()
             
        ElseIf nTipoRegua == 3
            fExemplo3()
             
        ElseIf nTipoRegua == 4
            RptStatus({|| fExemplo4()}, "Aguarde...", "Executando rotina...")
             
        ElseIf nTipoRegua == 5
            Processa({|| fExemplo5()}, "Filtrando...")
        EndIf
         
        lContinua := MsgYesNo("Continua testando?", "Atenção")
    EndDo
     
    RestArea(aArea)
Return
 
/*-----------------------------------------------------------*
 | Func.: fExemplo1                                          |
 | Desc.: Exemplo utilizando MsAguarde                       |
 *-----------------------------------------------------------*/
 
Static Function fExemplo1()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        MsProcTxt("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return
 
/*-----------------------------------------------------------*
 | Func.: fExemplo2                                          |
 | Desc.: Exemplo utilizando MsNewProcess                    |
 *-----------------------------------------------------------*/
 
Static Function fExemplo2(oObj)
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
    Local nAtu2  := 0
    Local nTot2  := 90
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    oObj:SetRegua1(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        oObj:IncRegua1("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        //Incrementando a régua 2
        oObj:SetRegua2(nTot2)
        For nAtu2 := 1 To nTot2
            oObj:IncRegua2("Posição " + cValToChar(nAtu2) + " de " + cValToChar(nTot2) + "...")
        Next
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return
 
/*-----------------------------------------------------------*
 | Func.: fExemplo3                                          |
 | Desc.: Exemplo utilizando MsgRun                          |
 *-----------------------------------------------------------*/
 
Static Function fExemplo3()
    Local aArea  := GetArea()
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Chamando a régua que irá executar o bloco de código (como um aEval, DbEval, etc)
    MsgRun("Lendo tabela...", "Título", {|| QRY_AUX->(DbEval({|x| nTotal++})) })
    QRY_AUX->(DbCloseArea())
     
    MsgInfo("Processado: " + cValToChar(nTotal) + " registro(s)", "Atenção")
     
    RestArea(aArea)
Return
 
/*-----------------------------------------------------------*
 | Func.: fExemplo4                                          |
 | Desc.: Exemplo utilizando RptStatus                       |
 *-----------------------------------------------------------*/
 
Static Function fExemplo4()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    SetRegua(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        IncRegua()
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
     
    RestArea(aArea)
Return
 
/*-----------------------------------------------------------*
 | Func.: fExemplo5                                          |
 | Desc.: Exemplo utilizando Processa                        |
 *-----------------------------------------------------------*/
 
Static Function fExemplo5()
    Local aArea  := GetArea()
    Local nAtual := 0
    Local nTotal := 0
     
    //Executa a consulta
    TCQuery cQryAux New Alias "QRY_AUX"
     
    //Conta quantos registros existem, e seta no tamanho da régua
    Count To nTotal
    ProcRegua(nTotal)
     
    //Percorre todos os registros da query
    QRY_AUX->(DbGoTop())
    While ! QRY_AUX->(EoF())
         
        //Incrementa a mensagem na régua
        nAtual++
        IncProc("Analisando registro " + cValToChar(nAtual) + " de " + cValToChar(nTotal) + "...")
         
        QRY_AUX->(DbSkip())
    EndDo
    QRY_AUX->(DbCloseArea())
    RestArea(aArea)
Return

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Relacionado

Tags: AdvPL Protheus Réguas de Processamento

George Lopes disse:

8 de maio de 2019 às 7:54 am

Muito bom mestre!

Responder
- Dan_Atilio disse:
  
  19 de maio de 2019 às 2:52 pm
  
  Boa tarde George.
  Obrigado pelo comentário.
  Grande abraço.
  
  Responder
Diego Sousa - Inativo disse:

8 de maio de 2019 às 8:14 am

Mais um excelente post Dan, eu nem sabia a barra dupla chamava MsNewProcess, parabéns pelo ótimo conteúdo!

Responder
- Dan_Atilio disse:
  
  19 de maio de 2019 às 2:52 pm
  
  Boa tarde Diego.
  Eu que agradeço pelo comentário.
  Grande abraço.
  
  Responder
Rubem Cerqueira disse:

9 de maio de 2019 às 4:51 pm

Excelente post meu amigo.

Um forte abraço

Responder
- Dan_Atilio disse:
  
  19 de maio de 2019 às 2:53 pm
  
  Obrigado Rubem.
  Grande abraço.
  
  Responder
Fabio disse:

18 de julho de 2019 às 7:32 pm

Muito bom.

Ajudou muito.

Responder
- Dan_Atilio disse:
  
  23 de julho de 2019 às 3:15 pm
  
  Obrigado pelo feedback.
  
  Responder
claudevan cavalcante disse:

25 de outubro de 2019 às 11:08 pm

Boa noite,

Dan Atilio, como faze um dialogo usando ProcRegua() e IncProc() sem a
utilizanção da função “processa()” pois eu queria que a regua fosse carregada
dentro de um dialogo, sem o Botão “Cancelar” Todos os exemplos seu tem Botões.

Queria saber se tem como fazer um dialogo e usar ProcRegua() e IncProc()
e só aparecer a regua carregando dentro desse dialogo SEM ter Botões?

Desde já obrigado!

Responder
- Dan_Atilio disse:
  
  29 de outubro de 2019 às 6:12 am
  
  Bom dia Claudevan, tudo bem?
  Então, no caso mesmo tendo o botão cancelar, é só não fazer a programação para ele, assim o usuário não vai conseguir clicar.
  Grande abraço.
  
  Responder