Consulta padrão com dados de Array

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

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
	
	//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 := ""
	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

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Dan_Atilio
Analista e desenvolvedor de sistemas. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas.

4 Responses

  1. Ricardo Batista Mendes disse:

    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.

    • Dan_Atilio disse:

      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.

  2. Ricardo Batista Mendes disse:

    Será que consegue montar um exemplo pra mim?

Deixe uma resposta