Tela de consulta de dados através de uma query via AdvPL

Olá pessoal…

Hoje vou mostrar uma função criada para utilizar uma tela de consulta específica, com a opção de pesquisar por trechos dos campos (com o LIKE do SQL).


Consulta de dados através de query SQL

Consulta de dados através de query SQL

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 zConsSQL, leia a postagem Consulta com marcação de dados no Protheus, é só fazer de forma similar.

A montagem da tela se baseia numa consulta sql, podendo se utilizar group by, alias de campo, subquery, etc.

A rotina recebe até 4 parâmetros, sendo:

cConsSQLM:  Consulta sql (sem o group by / order by)
cRetorM:    Qual será o retorno da consulta (campo da query, ex.: B1_COD, DA0_CODTAB, etc)
cAgrupM:    Agrupamento do Group By
cOrderM:    Ordenação do Order By

Abaixo o código fonte completo:

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"

//Constantes
#Define STR_PULA		Chr(13)+ Chr(10)

/*/{Protheus.doc} zConsSQL
Função para consulta genérica
@author Daniel Atilio
@since 15/12/2016
@version 1.0
	@param cConsSQLM, Caracter, Consulta SQL
	@param cRetorM, Caracter, Campo que será retornado
	@param cAgrupM, Caracter, Group By do SQL
	@param cOrderM, Caracter, Order By do SQL
	@return lRetorn, retorno se a consulta foi confirmada ou não
	@example
	lOK := u_zConsSQL("SELECT B1_COD, B1_DESC FROM SB1010 WHERE D_E_L_E_T_ = ' ' ", "B1_COD", "", "B1_COD")
	...
	u_zConsSQL("SELECT * FROM ZA0990", "ZA0_COD", "", "")
	...
	@obs O retorno da consulta é pública (__cRetorno) para ser usada em consultas específicas
	A consulta não pode ter ORDER BY, pois ele já é especificado em um parâmetro
/*/

User Function zConsSQL(cConsSQLM, cRetorM, cAgrupM, cOrderM)
	Local aArea   := GetArea()
	Local nTamBtn := 50
	Local oGrpPesqui
	Local oGrpDados
	Local oGrpAcoes
	Local oBtnConf
	Local oBtnLimp
	Local oBtnCanc
	//Defaults
	Default cConsSQLM := ""
	Default cRetorM   := ""
	Default cOrderM   := ""
	//Privates
	Private cConsSQL  := cConsSQLM
	Private cCampoRet := cRetorM
	Private cAgrup    := cAgrupM
	Private cOrder    := cOrderM
	Private nTamanRet := 0
	Private aStruAux    := {}
	//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.
	Public  __cRetorno := ""
	
	//Se tiver o alias em branco ou não tiver campos
	If Empty(cConsSQLM) .Or. Empty(cRetorM)
		MsgStop("SQL e / ou retorno em branco!", "Atenção")
		Return lRetorn
	EndIf
	
	//Criando a estrutura para a MsNewGetDados
	fCriaMsNew()
	__cRetorno := Space(nTamanRet)
	
	//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:  15/12/2016                                                   |
 | Desc:  Função para criar a estrutura da MsNewGetDados               |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fCriaMsNew()
	Local aAreaX3 := SX3->(GetArea())
	Local cQuery  := ""
	Local nAtual  := 0

	//Zerando o cabeçalho e a estrutura
	aHeadAux := {}
	aColsAux := {}
	
	//Monta a consulta e pega a estrutura
	cQuery := cConsSQL
	
	//Group By
	If !Empty(cAgrup)
		cQuery += cAgrup + STR_PULA
	EndIf
	
	//Order By
	cQuery += " ORDER BY "	+ STR_PULA
	If !Empty(cOrder)
		cQuery += "   "+cOrder
	Else
		cQuery += "   "+cCampoRet
	EndIf
	TCQuery cQuery New Alias "QRY_DAD"
	aStruAux := QRY_DAD->(DbStruct())
	QRY_DAD->(DbCloseArea())
	
	DbSelectArea("SX3")
	SX3->(DbSetOrder(2)) // Campo
	SX3->(DbGoTop())
	
	//Percorrendo os campos
	For nAtual := 1 To Len(aStruAux)
		cCampoAtu := aStruAux[nAtual][1]
	
		//Se coneguir posicionar no campo
		If SX3->(DbSeek(cCampoAtu))
			//Cabeçalho ...	Titulo		Campo		Mask									Tamanho				Dec					Valid	Usado	Tip				F3	CBOX
			aAdd(aHeadAux,{	X3Titulo(),	cCampoAtu,	PesqPict(SX3->X3_ARQUIVO, cCampoAtu),	SX3->X3_TAMANHO,	SX3->X3_DECIMAL,	".F.",	".F.",	SX3->X3_TIPO,	"",	""})
			
			//Se o campo atual for retornar, aumenta o tamanho do retorno
			If cCampoAtu $ cCampoRet
				nTamanRet += SX3->X3_TAMANHO
			EndIf
			
		Else
			//Cabeçalho ...	Titulo									Campo		Mask	Tamanho					Dec						Valid	Usado	Tip						F3	CBOX
			aAdd(aHeadAux,{	Capital(StrTran(cCampoAtu, '_', ' ')),	cCampoAtu,	"",		aStruAux[nAtual][3],	aStruAux[nAtual][4],	".F.",	".F.",	aStruAux[nAtual][2],	"",	""})
			
			//Se o campo atual for retornar, aumenta o tamanho do retorno
			If cCampoAtu $ cCampoRet
				nTamanRet += aStruAux[nAtual][3]
			EndIf
		EndIf
	Next
	
	RestArea(aAreaX3)
Return

/*---------------------------------------------------------------------*
 | Func:  fPopula                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  15/12/2016                                                   |
 | Desc:  Função que popula a tabela auxiliar da MsNewGetDados         |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fPopula()
	Local cQuery := ""
	Local nAtual := 0
	aColsAux :={}
	nCampAux := 1

	//Faz a consulta
	cQuery := cConsSQL + STR_PULA
	
	//Se tiver Filtro
	If !Empty(cGetPesq)
		If 'WHERE' $ cQuery
			cQuery += "   AND "
		Else
			cQuery += "   WHERE "
		EndIf
		cQuery += " ( "
		For nAtual := 1 To Len(aStruAux)
			cCampoAtu := aStruAux[nAtual][1]
			If aStruAux[nAtual][2] == 'C'
				cQuery += " UPPER("+cCampoAtu+") LIKE '%"+Upper(Alltrim(cGetPesq))+"%' OR"
			EndIf
		Next
		cQuery := SubStr(cQuery, 1, Len(cQuery)-2)
		cQuery += ")"+STR_PULA
	EndIf
	
	//Group By
	If !Empty(cAgrup)
		cQuery += cAgrup + STR_PULA
	EndIf
	
	//Order By
	cQuery += " ORDER BY "	+ STR_PULA
	If !Empty(cOrder)
		cQuery += "   "+cOrder
	Else
		cQuery += "   "+cCampoRet
	EndIf
	TCQuery cQuery New Alias "QRY_DAD"
	
	//Percorrendo a estrutura, procurando campos de data
	For nAtual := 1 To Len(aHeadAux)
		//Se for data
		If aHeadAux[nAtual][8] == "D"
			TCSetField('QRY_DAD', aHeadAux[nAtual][2], 'D')
		//Se for data
		ElseIf aHeadAux[nAtual][8] == "N"
			TCSetField('QRY_DAD', aHeadAux[nAtual][2], 'N', aHeadAux[nAtual][4], aHeadAux[nAtual][5])
		EndIf
	Next
	
	//Enquanto tiver dados
	While ! QRY_DAD->(EoF())
		nCampAux := 1
		aAux := {}
		//Percorrendo os campos e adicionando no acols e com o delet
		For nAtual := 1 To Len(aStruAux)
			cCampoAtu := aStruAux[nAtual][1]
			
			If aStruAux[nAtual][2] $ "N;D"
				aAdd(aAux,  &("QRY_DAD->"+cCampoAtu) )
			Else
				aAdd(aAux, cValToChar( &("QRY_DAD->"+cCampoAtu) ))
			EndIf
		Next
		aAdd(aAux, .F.)
	
		aAdd(aColsAux, aClone(aAux))
		QRY_DAD->(DbSkip())
	EndDo
	QRY_DAD->(DbCloseArea())
	
	//Se não tiver dados, adiciona linha em branco
	If Len(aColsAux) == 0
		aAux := {}
		
		//Percorrendo os campos e adicionando no acols e com o delet
		For nAtual := 1 To Len(aStruAux)
			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:  15/12/2016                                                   |
 | Desc:  Função de confirmação da rotina                              |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fConfirm()
	Local aAreaX3 := SX3->(GetArea())
	Local cAux := ""
	Local aColsNov := oMsNew:aCols
	Local nLinAtu  := oMsNew:nAt
	Local nAtual

	//Percorrendo os campos
	For nAtual := 1 To Len(aHeadAux)
		cCampoAtu := aHeadAux[nAtual][2]
	
		//Se o campo atual for retornar, soma com o auxiliar
		If cCampoAtu $ cCampoRet
			cAux += aColsNov[nLinAtu][nAtual]
		EndIf
	Next

	//Setando o retorno conforme auxiliar e finalizando a tela
	lRetorn := .T.
	__cRetorno := cAux
	
	//Se tiver retorno
	If Len(__cRetorno) != 0
		//Se o tamanho for menor, adiciona
		If Len(__cRetorno) < nTamanRet
			__cRetorno += Space(nTamanRet - Len(__cRetorno))
		
		//Senão se for maior, diminui
		ElseIf Len(__cRetorno) > nTamanRet
			__cRetorno := SubStr(__cRetorno, 1, nTamanRet)
		EndIf
	EndIf
	
	oDlgEspe:End()
	RestArea(aAreaX3)
Return

/*---------------------------------------------------------------------*
 | Func:  fLimpar                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  15/12/2016                                                   |
 | 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:  15/12/2016                                                   |
 | Desc:  Função de cancelamento da rotina                             |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fCancela()
	//Setando o retorno em branco e finalizando a tela
	lRetorn := .F.
	__cRetorno := Space(nTamanRet)
	oDlgEspe:End()
Return

/*---------------------------------------------------------------------*
 | Func:  fVldPesq                                                     |
 | Autor: Daniel Atilio                                                |
 | Data:  15/12/2016                                                   |
 | 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.

Dan (Daniel Atilio)
Cristão de ramificação protestante. Especialista em Engenharia de Software pela FIB, graduado em Banco de Dados pela FATEC Bauru e técnico em informática pelo CTI da Unesp. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor e mantenedor do portal Terminal de Informação.

22 Responses

  1. Erick disse:

    Bom dia, otimo artigo, estou com uma necessidade ao chamar esta tela nao trazer os produtos, tenho muito produto fica lento a consulta a cada F3. Teria como chamar ela vazia e ao pesquisar a descricao do item popular ela com a select ?
    Estou usando ela no venda assistida.
    Obrigado

    • Dan_Atilio disse:

      Boa noite Erick.
      Você poderia criar uma variável private logo após a lRetorn, chamada de nVez, declarando igual a 0.
      Ai antes do Order By, você teria um trecho assim:

      ...
      cQuery += ")"+STR_PULA
      If nVez == 0
           cQuery += " AND 1 = 0"+STR_PULA
      EndIf
      nVez++
      cQuery += " ORDER BY "    + STR_PULA
      ...
      
  2. Erick disse:

    postei em artigo errado. Desculpa

  3. Evandro disse:

    Ola Boa tarde.

    Estou com dificuldades no retorno e quando clico em cancelo não fecha a rotina. Estou utilizando para buscar clientes na SA1

    Meus parâmetros NÃO RETORNAM.

    E quando cancelo/fecho ele fica chamando a rotina novamente.

    • Dan_Atilio disse:

      Bom dia Evandro, tudo bem?
      No caso, você está chamando pela consulta padrão (F3) ? Se sim, mande um print do cadastro da sua consulta específica.
      Senão, especifique como você está chamando a user function.

  4. Evandro Santos disse:

    Ola estou com dificuldades em implementar. Poderia me ajudar?

    Fiz duas perguntas, mas não estão aparecendo no Blog. Existe outro canal para comunicação?

    Muito obrigado.

    • Dan_Atilio disse:

      Bom dia Evandro, tudo bem?
      A primeira vez que é efetuado um comentário no site, o e-Mail da pessoa fica em uma lista de aprovação, por isso não estavam aparecendo.
      Quanto a outros meios de comunicação, existe a página de Contato no cabeçalho do site (entre AdvPL e Doações), e no fim de cada artigo, existe uma descrição sobre o autor linkando as redes sociais.

      Agora, vamos a sua dúvida. Se for algo escrito, até daria para colocar, mas como essa é a uma tela genérica, ela não tem suporte as legendas (BR_VERMELHO, BR_AZUL, BR_AMARELO, etc).
      Se necessário, é possível você customizar isso, como o fonte é open source, bastaria você mexer em dois pontos do fonte, o primeiro é na adição das colunas do aHeader (aproximadamente entre as linhas 151 e 180). O segundo ponto a se alterar é na hora de popular as linhas do aCols (aproximadamente entre as linhas 243 e 262).

      Espero ter ajudado.

      Abraços.

  5. Evandro Santos disse:

    Ainda não consegui utilizar em uma consulta especifica com o F3.

  6. Evandro Santos disse:

    Dan consegui fazer utilizando outra rotina disponível no terminal de informação. Mas agora precisaria da função que pega os campos que tem Xx_ na frente eu mandei msg no referido post. Por favor preciso mto desse Help. Se puder ajudar evandro_apsantos@hotmail.com

  7. Thiago disse:

    Olá Dan, boa tarde.
    A função pesquisar não está funcionando. Eu escrevo o texto e não filtra nada, depois de aberta a pesquisa F3. Poderia me auxiliar?

  8. Thiago disse:

    Outra dúvida, tenho como, no retorno, colocar para ele focar o próximo campo?

    • Dan_Atilio disse:

      Então Thiago.
      Isso o Protheus faz automaticamente, ao pressionar F3, e escolher um retorno, ele já deixa posicionado no próximo.
      O que pode impactar é a forma como foi criado a consulta padrão / específica (SXB) ou validações de campo.
      Abraços.

  9. Ricardo Mendes disse:

    Boa Noite,
    Eu consigo fazer o retorno de dois campos nessa pesquisa?

  10. Henrique Sciascio disse:

    Bom dia Atilio tudo bem?
    Não sei se só eu tive essa duvida, mas como eu faço para colocar essa tela em uma consulta padrão(ou especifica) de algum campo sendo essa consulta personalizada?

    • Bom dia Henrique, tudo joia?

      Opa, para fazer o cadastro, nós citamos um link nessa parte aqui […]leia a postagem Consulta com marcação de dados no Protheus, […], ai nela, tem um link que se você clicar vai abrir uma página com prints do tutorial (você pode dar um ctrl+f na página ou se quiser segue o link que foi citado no artigo – https://terminaldeinformacao.com/2015/06/16/consulta-com-marcacao-de-dados-no-protheus/ ).

      Mas resumidamente, você teria que:
      1. Abrir o Configurador (SIGACFG)
      2. Ir na Base De Dados ai em seguida em Consulta Padrão
      3. Clica em Incluir, escolhe o tipo Consulta Específica
      4. Na tabela, pode escolher a mesma da Query (ex.: SB1)
      5. Na Expressão, coloque a chamada da User function, por exemplo, u_zConsSQL(“SELECT B1_COD, B1_DESC FROM SB1010 WHERE D_E_L_E_T_ = ‘ ‘ “, “B1_COD”, “”, “B1_COD”)
      6. No retorno, coloque o nome da variável pública, __cRetorno

      Um grande abraço.

Deixe uma resposta

Terminal de Informação