Olá pessoal…
Hoje vou mostrar uma função que é uma tela de consulta de dados (que pode ser cadastrada como uma consulta padrão), utilizando informações de um Array.
A rotina criada, basicamente carrega os dados de um Array em uma tela para consulta, assim podendo selecionar os registros.
A construção da rotina, foi similar a zConsMark, que é a consulta que criei com marcação de dados, caso queira cadastrar uma consulta padrão utilizando a zConsArr, leia a postagem Consulta com marcação de dados no Protheus, é só fazer de forma similar, você pode utilizar o exemplo abaixo, a rotina zTstCons().
Abaixo um print do exemplo:
Consulta de dados – Array
Abaixo o código fonte desenvolvido:
//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"
//Constantes
#Define STR_PULA Chr(13)+Chr(10)
/*/{Protheus.doc} zTstCons
Função de exemplo de consulta de dados via Array (zConsArr)
@type function
@author Atilio
@since 30/07/2016
@version 1.0
/*/
User Function zTstCons()
Local lOk := .F.
Local aDados := {}
//Adicionando os dados no array
aAdd(aDados, {"0001", "Daniel", 23})
aAdd(aDados, {"0002", "Hudson", 33})
aAdd(aDados, {"0003", "Atilio", 43})
//Chamando a consulta
lOk := u_zConsArr(aDados, 1, 3, {"Codigo","Nome","Idade"}, {04, 50, 3})
//Se foi confirmado, mostra mensagem
If lOk
MsgInfo("O escolhido foi: "+__cRetorn+"!", "Atenção")
EndIf
Return lOk
/*/{Protheus.doc} zConsArr
Função para consulta genérica
@author Daniel Atilio
@since 05/06/2015
@version 1.0
@param aDadosM, Array, Array multidimensional que tem o retorno
@param nPosRetM, Numérico, Posição de retorno
@param nColsM, Numérico, Quantidade de colunas
@param aTitulosM, Array, Array com os títulos dos campos
@return lRetorn, retorno se a consulta foi confirmada ou não
@example
u_zConsArr(aDados, 1, 3, {"Campo1","Campo2","Campo3"}, {10, 10, 20})
@obs O retorno da consulta é pública (__cRetorn) para ser usada em consultas específicas
/*/
User Function zConsArr(aDadosM, nPosRetM, nColsM, aTitulosM, aTamanM)
Local aArea := GetArea()
Local nTamBtn := 50
//Defaults
Default aDadosM := {}
Default nPosRetM := 0
Default nColsM := 0
Default aTitulosM := {}
Default aTamanM := {}
//Privates
Private aCampos := aDadosM
Private nPosRet := nPosRetM
Private nCols := nColsM
Private aTitulos := aTitulosM
Private aTaman := aTamanM
//MsNewGetDados
Private oMsNew
Private aHeadAux := {}
Private aColsAux := {}
//Tamanho da janela
Private nJanLarg := 0800
Private nJanAltu := 0500
//Gets e Dialog
Private oDlgEspe
Private oGetPesq, cGetPesq := Space(100)
//Retorno
Private lRetorn := .F.
Private nTamanRet := Iif(Len(aDadosM) >= 1, Len(aDadosM[1][nPosRet]), 18)
Public __cRetorn := ""
//Se tiver o alias em branco ou não tiver campos
If Len(aDadosM) <= 0 .Or. (nPosRetM == 0) .Or. (nColsM == 0)
MsgStop("Sem campos!", "Atenção")
Return lRetorn
EndIf
//Criando a estrutura para a MsNewGetDados
fCriaMsNew()
//Criando a janela
DEFINE MSDIALOG oDlgEspe TITLE "Consulta de Dados" FROM 000, 000 TO nJanAltu, nJanLarg COLORS 0, 16777215 PIXEL
//Pesquisar
@ 003, 003 GROUP oGrpPesqui TO 025, (nJanLarg/2)-3 PROMPT "Pesquisar: " OF oDlgEspe COLOR 0, 16777215 PIXEL
@ 010, 006 MSGET oGetPesq VAR cGetPesq SIZE (nJanLarg/2)-12, 010 OF oDlgEspe COLORS 0, 16777215 VALID (fVldPesq()) PIXEL
//Dados
@ 028, 003 GROUP oGrpDados TO (nJanAltu/2)-28, (nJanLarg/2)-3 PROMPT "Dados: " OF oDlgEspe COLOR 0, 16777215 PIXEL
oMsNew := MsNewGetDados():New( 035,; //nTop
006,; //nLeft
(nJanAltu/2)-31,; //nBottom
(nJanLarg/2)-6,; //nRight
GD_INSERT+GD_DELETE+GD_UPDATE,; //nStyle
"AllwaysTrue()",; //cLinhaOk
,; //cTudoOk
"",; //cIniCpos
,; //aAlter
,; //nFreeze
999,; //nMax
,; //cFieldOK
,; //cSuperDel
,; //cDelOk
oDlgEspe,; //oWnd
aHeadAux,; //aHeader
aColsAux) //aCols
oMsNew:lActive := .F.
oMsNew:oBrowse:blDblClick := {|| fConfirm()}
//Populando os dados da MsNewGetDados
fPopula()
//Ações
@ (nJanAltu/2)-25, 003 GROUP oGrpAcoes TO (nJanAltu/2)-3, (nJanLarg/2)-3 PROMPT "Ações: " OF oDlgEspe COLOR 0, 16777215 PIXEL
@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*1)+06) BUTTON oBtnConf PROMPT "Confirmar" SIZE nTamBtn, 013 OF oDlgEspe ACTION(fConfirm()) PIXEL
@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*2)+09) BUTTON oBtnLimp PROMPT "Limpar" SIZE nTamBtn, 013 OF oDlgEspe ACTION(fLimpar()) PIXEL
@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*3)+12) BUTTON oBtnCanc PROMPT "Cancelar" SIZE nTamBtn, 013 OF oDlgEspe ACTION(fCancela()) PIXEL
oMsNew:oBrowse:SetFocus()
//Ativando a janela
ACTIVATE MSDIALOG oDlgEspe CENTERED
RestArea(aArea)
Return lRetorn
/*---------------------------------------------------------------------*
| Func: fCriaMsNew |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função para criar a estrutura da MsNewGetDados |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fCriaMsNew()
Local cCampoAtu := "XX_CAMP000"
Local nTamanAtu := 0
Local nAtual
//Percorrendo os campos
For nAtual := 1 To nCols
cCampoAtu := Soma1(cCampoAtu)
nTamanAtu := 10
//Se tiver título
If ! (nAtual > Len(aTitulos))
cTituloAux := aTitulos[nAtual]
Else
cTituloAux := Capital(StrTran(cCampoAtu, "XX_", ""))
EndIf
//Se tiver tamanho
If nAtual >= Len(aTaman)
nTamanAtu := aTaman[nAtual]
EndIf
//Cabeçalho ... Titulo Campo Mask Tamanho Dec Valid Usado Tip F3 CBOX
aAdd(aHeadAux,{ cTituloAux, cCampoAtu, "", nTamanAtu, 0, ".F.", ".F.", "C", "", ""})
Next
Return
/*---------------------------------------------------------------------*
| Func: fPopula |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função que popula a tabela auxiliar da MsNewGetDados |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fPopula()
Local xAux := ""
Local nColuna
Local nLinha
Local nAtual
aColsAux :={}
//Percorrendo linhas
For nLinha := 1 To Len(aCampos)
lFiltro := .F.
//Se tiver filtro, verifica um a um se tem a expressão
If !Empty(cGetPesq)
//percorrendo colunas
For nColuna := 1 To nCols
xAux := aCampos[nLinha][nColuna]
If ValType(xAux) != 'C'
xAux := cValToChar(xAux)
EndIf
//Se tiver na pesquisa
If Alltrim(Lower(cGetPesq)) $ Lower(xAux)
lFiltro := .T.
EndIf
Next
//Se não tiver filtro, traz tudo
Else
lFiltro := .T.
EndIf
//Se tiver filtrado ok
If lFiltro
aAux := {}
//percorrendo colunas
For nColuna := 1 To nCols
aAdd(aAux, aCampos[nLinha][nColuna])
Next
aAdd(aAux, .F.)
aAdd(aColsAux, aClone(aAux))
EndIf
Next
//Se não tiver dados, adiciona linha em branco
If Len(aColsAux) == 0
aAux := {}
//Percorrendo os campos e adicionando no acols (junto com o recno e com o delet
For nAtual := 1 To nCols
aAdd(aAux, '')
Next
aAdd(aAux, .F.)
aAdd(aColsAux, aClone(aAux))
EndIf
//Posiciona no topo e atualiza grid
oMsNew:SetArray(aColsAux)
oMsNew:oBrowse:Refresh()
Return
/*---------------------------------------------------------------------*
| Func: fConfirm |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função de confirmação da rotina |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fConfirm()
//Local cAux := ""
Local aColsNov := oMsNew:aCols
Local nLinAtu := oMsNew:nAt
lRetorn := .T.
__cRetorn := aColsNov[nLinAtu][nPosRet]
oDlgEspe:End()
Return
/*---------------------------------------------------------------------*
| Func: fLimpar |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função que limpa os dados da rotina |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fLimpar()
//Zerando gets
cGetPesq := Space(100)
oGetPesq:Refresh()
//Atualiza grid
fPopula()
//Setando o foco na pesquisa
oGetPesq:SetFocus()
Return
/*---------------------------------------------------------------------*
| Func: fCancela |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função de cancelamento da rotina |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fCancela()
//Setando o retorno em branco e finalizando a tela
lRetorn := .F.
__cRetorn := Space(nTamanRet)
oDlgEspe:End()
Return
/*---------------------------------------------------------------------*
| Func: fVldPesq |
| Autor: Daniel Atilio |
| Data: 05/06/2015 |
| Desc: Função que valida o campo digitado |
| Obs.: / |
*---------------------------------------------------------------------*/
Static Function fVldPesq()
Local lRet := .T.
//Se tiver apóstrofo ou porcentagem, a pesquisa não pode prosseguir
If "'" $ cGetPesq .Or. "%" $ cGetPesq
lRet := .F.
MsgAlert("<b>Pesquisa inválida!</b><br>A pesquisa não pode ter <b>'</b> ou <b>%</b>.", "Atenção")
EndIf
//Se houver retorno, atualiza grid
If lRet
fPopula()
EndIf
Return lRet
Bom pessoal, por hoje é só.
Abraços e até a próxima.
Existe a possibilidade de ter as duas consultas juntas
Eu preciso passar um array com as opções que o usuário pode marcar para trazer e ser utilizado em relatorio.
https://terminaldeinformacao.com/2015/06/16/consulta-com-marcacao-de-dados-no-protheus/
Eu não consigo montar isso via SQL para usar a consulta acima… então queria ver se tem como a partir da consulta por array, trazer as opções de marcação.
Bom dia Ricardo, tudo bem?
Existe sim, daria para você pegar a consulta com marcação, e ao invés de receber um Alias no parâmetro, você receberia um Array.
Ai na montagem dos dados, ao invés de executar uma query, você iria dar um For nesse Array.
Qualquer dúvida, pode entrar em contato.
Um grande abraço.
Será que consegue montar um exemplo pra mim?
Boa noite Ricardo, tudo bem?
No artigo tem um exemplo explicativo, o zTstCons(). Dê uma olhada, se ficar alguma dúvida, por favor entre em contato.
Um grande abraço.