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:
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.