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.

18 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?

Deixe uma resposta para Dan_AtilioCancelar resposta

Terminal de Informação