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.
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.