Consulta Específica com Like de dados em AdvPL

Consulta Específica com Like de dados em AdvPL

Olá pessoal…

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


Consulta específica filtrando a letra
Consulta específica filtrando a letra “o”

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

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

cAliasM:  Alias da consulta (SB1, SA1, SA2, etc)
aCamposM: Campos que irão compor a tela (o R_E_C_N_O_ sempre será mostrado, e se tiver algum campo começando com "XX_", será substituído em tempo de execução, conforme o parâmetro aColsM)
cFiltroM: Filtragem SQL dos dados
cRetorM:  Qual será o retorno da consulta (B1_COD, DA0_CODTAB, etc)
aColsM:   Colunas específicas que substituem as que começam com XX_
cOrdM:    Ordenação do Order By

Abaixo um exemplo de consulta específica de ordens de produção.

u_zConsEsp( "SC2",; //Alias
            {"C2_NUM","C2_ITEM","C2_SEQUEN","C2_OBS","C2_PRODUTO","C2_CC","XX_SALDO"},; //Colunas
            " AND C2_FILIAL = '"+FWxFilial('SC2')+"' AND C2_DATRF = ' ' ",; //Filtro
            "C2_NUM+C2_ITEM+C2_SEQUEN",; //Retorno
            {"u_zRetSC2Sld(QRY_DAD->RECNUM)"}) //Substituição das colunas que começam com XX_

Abaixo o código fonte completo:

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

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

/*/{Protheus.doc} zConsEsp
Função para consulta genérica
@author Daniel Atilio
@since 24/02/2015
@version 1.0
	@param cAliasM, Caracter, Alias da tabela consultada
	@param aCamposM, Array, Campos que serão montados na grid de marcação
	@param cFiltroM, Caracter, Filtragem da tela (SQL)
	@param cRetorM, Caracter, Campo que será checado
	@param aColsM, Array, Conteúdo de campos específicos, que iniciam com XX_ no aCamposM
	@param cOrdM, Caracter, Campos utilizados no Order By
	@return lRetorn, retorno se a consulta foi confirmada ou não
	@example
	u_zConsEsp("SED", {"ED_CODIGO","ED_DESCRIC"}, " AND ED_FILIAL = '"+xFilial("SED")+"' ", "ED_CODIGO")
	u_zConsEsp("SB1", {"B1_COD","B1_DESC","B1_TIPO"}, " AND B1_FILIAL = '"+xFilial("SB1")+"' ", "B1_COD")
	...
	User Function zConsSC2()
		lOk := u_zConsEsp("SC2", {"C2_NUM","C2_ITEM","C2_SEQUEN","C2_OBS","C2_PRODUTO","C2_CC","XX_SALDO"},, "C2_NUM+C2_ITEM+C2_SEQUEN",{"u_zRetSC2Sld(QRY_DAD->RECNUM)"})
	Return lOk
	@obs O retorno da consulta é pública (__cRetorn) para ser usada em consultas específicas
	Caso seja necessário incluir campos específicos na grid, utilize o prefixo XX_ antes do nome do campo no aCamposM,
	   e seu conteúdo preencha no aColsM
/*/

User Function zConsEsp(cAliasM, aCamposM, cFiltroM, cRetorM, aColsM, cOrdM)
	Local aArea := GetArea()
	Local nTamBtn := 50
	//Defaults
	Default cAliasM := ""
	Default aCamposM := {}
	Default cFiltroM := ""
	Default cRetorM := ""
	Default aColsM := {}
	Default cOrdM := ""
	//Privates
	Private cFiltro := cFiltroM
	Private cAliasPvt := cAliasM
	Private aCampos := aCamposM
	Private nTamanRet := 0
	Private cCampoRet := cRetorM
	Private aColsEsp := aColsM
	Private cOrder := cOrdM
	//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  __cRetorn := ""
	
	//Se tiver o alias em branco ou não tiver campos
	If Empty(cAliasM) .Or. Len(aCamposM) <= 0 .Or. Empty(cRetorM)
		MsgStop("Alias em branco e/ou Sem campos para marcação!", "Atenção")
		Return lRetorn
	EndIf
	
	//Criando a estrutura para a MsNewGetDados
	fCriaMsNew()
	__cRetorn := 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
			@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*4)+15) BUTTON oBtnVisu PROMPT "Visualizar" SIZE nTamBtn, 013 OF oDlgEspe ACTION(fVisual())     PIXEL
		
		oMsNew:oBrowse:SetFocus()
	//Ativando a janela
	ACTIVATE MSDIALOG oDlgEspe CENTERED
	
	RestArea(aArea)
Return lRetorn

/*---------------------------------------------------------------------*
 | Func:  fCriaMsNew                                                   |
 | Autor: Daniel Atilio                                                |
 | Data:  24/02/2015                                                   |
 | Desc:  Função para criar a estrutura da MsNewGetDados               |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fCriaMsNew()
	Local aAreaX3 := SX3->(GetArea())

	//Zerando o cabeçalho e a estrutura
	aHeadAux := {}
	aColsAux := {}
	
	DbSelectArea("SX3")
	SX3->(DbSetOrder(2)) // Campo
	SX3->(DbGoTop())
	
	//Percorrendo os campos
	For nAtual := 1 To Len(aCampos)
		cCampoAtu := aCampos[nAtual]
		
		//Se iniciar com XX_
		If SubStr(cCampoAtu, 1, 3) == "XX_"
			//Cabeçalho ...	Titulo											Campo			Mask		Tamanho	Dec		Valid	Usado	Tip		F3	CBOX
			aAdd(aHeadAux,{	Capital(StrTran(cCampoAtu, "XX_", "")),	cCampoAtu,		"",			18,			0,		".F.",	".F.",	"C",	"",	""})
		ElseIf SubStr(cCampoAtu, 1, 3) == "YY_"
			//Cabeçalho ...	Titulo											Campo			Mask		Tamanho	Dec		Valid	Usado	Tip		F3	CBOX
			aAdd(aHeadAux,{	Capital(StrTran(cCampoAtu, "YY_", "")),	cCampoAtu,		"",			100,			0,		".F.",	".F.",	"C",	"",	""})
		Else
	
			//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(cAliasPvt  , cCampoAtu),	TamSX3(cCampoAtu)[01],	TamSX3(cCampoAtu)[02],	".F.",	".F.",	SX3->X3_TIPO,	"",	""})
				
				//Se o campo atual for retornar, aumenta o tamanho do retorno
				If cCampoAtu $ cCampoRet
					nTamanRet += TamSX3(cCampoAtu)[01]
				EndIf
			EndIf
		
		EndIf
	Next
	
	//Cabeçalho ...	Titulo		Campo			Mask						Tamanho	Dec		Valid	Usado	Tip		F3	CBOX
	aAdd(aHeadAux,{	"RecNo",	"XX_RECNUM",	"@E 999999999999999999",	18,			0,		".F.",	".F.",	"C",	"",	""})
	
	RestArea(aAreaX3)
Return

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

Static Function fPopula()
	aColsAux :={}
	nCampAux := 1

	//Faz a consulta
	cQuery := " SELECT "	+ STR_PULA
	cQuery += "    TOP 100 R_E_C_N_O_ AS RECNUM, "
	For nAtual := 1 To Len(aCampos)
		cCampoAtu := aCampos[nAtual]
		If SubStr(cCampoAtu, 1, 3) == "YY_"
			cQuery += " "+aColsEsp[nCampAux]+" AS "+cCampoAtu+","
			nCampAux++
		ElseIf SubStr(cCampoAtu, 1, 3) != "XX_"
			cQuery += " "+cCampoAtu+","
		EndIf
	Next
	cQuery := SubStr(cQuery, 1, Len(cQuery)-1)	+ STR_PULA
	cQuery += " FROM "	+ STR_PULA
	cQuery += "   "+RetSQLName(cAliasPvt)+" "+cAliasPvt+" "	+ STR_PULA
	cQuery += " WHERE "	+ STR_PULA
	cQuery += "   "+cAliasPvt+".D_E_L_E_T_='' " + STR_PULA
	cQuery += "   "+cFiltro+" " + STR_PULA
	cQuery += "   AND ("
	For nAtual := 1 To Len(aCampos)
		cCampoAtu := aCampos[nAtual]
		If SubStr(cCampoAtu, 1, 3) != "XX_" .And. SubStr(cCampoAtu, 1, 3) != "YY_"
			cQuery += " UPPER("+cCampoAtu+") LIKE '%"+Upper(Alltrim(cGetPesq))+"%' OR"
		EndIf
	Next
	cQuery := SubStr(cQuery, 1, Len(cQuery)-2)
	cQuery += ")"+STR_PULA
	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" .And. SubStr(aHeadAux[nAtual][1], 1, 3) != "XX_"
			TCSetField('QRY_DAD', aHeadAux[nAtual][2], 'D')
		EndIf
	Next
	
	//Enquanto tiver dados
	While ! QRY_DAD->(EoF())
		nCampAux := 1
		aAux := {}
		//Percorrendo os campos e adicionando no acols (junto com o recno e com o delet
		For nAtual := 1 To Len(aCampos)
			cCampoAtu := aCampos[nAtual]
			//Se iniciar com XX_
			If SubStr(cCampoAtu, 1, 3) == "XX_"
				aAdd(aAux, &(aColsEsp[nCampAux]))
				nCampAux++
				
			//Senão, adiciona conforme consulta
			Else
				aAdd(aAux, cValToChar( &("QRY_DAD->"+cCampoAtu) ))
			EndIf
		Next
		aAdd(aAux, QRY_DAD->RECNUM)
		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 (junto com o recno e com o delet
		For nAtual := 1 To Len(aCampos)
			aAdd(aAux, '')
		Next
		aAdd(aAux, 0)
		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:  24/02/2015                                                   |
 | 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
	
	DbSelectArea("SX3")
	SX3->(DbSetOrder(2)) // Campo
	SX3->(DbGoTop())

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

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

/*---------------------------------------------------------------------*
 | Func:  fLimpar                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  24/02/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:  24/02/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:  24/02/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

/*---------------------------------------------------------------------*
 | Func:  fVisual                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  24/02/2015                                                   |
 | Desc:  Função de visualizar o registro                              |
 | Obs.:  /                                                            |
 *---------------------------------------------------------------------*/

Static Function fVisual()
	Local cAux := ""
	Local aColsNov := oMsNew:aCols
	Local nLinAtu  := oMsNew:nAt
	Local nPosRec  := aScan(aHeadAux,{|x| AllTrim(Upper(x[2]))=="XX_RECNUM" })
	
	//Visualizando o registro
	(cAliasPvt)->(DbGoTo(aColsNov[nLinAtu][nPosRec]))
	AxVisual(cAliasPvt, aColsNov[nLinAtu][nPosRec], 2)
Return

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.

About 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. Autor do projeto Terminal de Informação, onde são postados tutoriais e notícias envolvendo o mundo da tecnologia.

3 thoughts on “Consulta Específica com Like de dados em AdvPL

  1. Bom dia pessoal. rotina bem bacana. Só que não consegui fazer retornar o valor para o campo quando é no acols. Parece que falta um refresh na tela mas não consigo descobrir onde é. Estou tentando fazer um teste no acols da Solicitacao de compras, campo C1_CC.

    1. Boa noite Jair, tudo bem?

      Primeiramente crie uma consulta específica apontando para a tabela de centro de custo (no meu caso criei com o nome X_CTT):
      https://terminaldeinformacao.com/wp-content/uploads/2017/04/ctt_01.png

      Depois, vá no campo C1_CC, e na consulta padrão, aponte para essa consulta criada:
      https://terminaldeinformacao.com/wp-content/uploads/2017/04/ctt_02.png

      Por último, basta abrir o cadastro, e testar se deu certo:
      https://terminaldeinformacao.com/wp-content/uploads/2017/04/ctt_03.png

      Abaixo a fórmula que usei na consulta:

      u_zConsEsp("CTT", {"CTT_CUSTO","CTT_DESC01"}, " AND CTT_FILIAL = '"+xFilial("CTT")+"' ", "CTT_CUSTO")
      

      Espero ter ajudado.

      Abraços.

Deixe uma resposta

%d blogueiros gostam disto: