Hoje trago para vocês como fazer um cadastro usando DbTree em AdvPL.
Muitas pessoas me perguntam se é possível fazer um cadastro viável em DbTree, pois bem jovens, faz muito tempo que não mexo com esse componente, mas eu fiz um cadastro desse tipo uma vez em 2016, então provavelmente o fonte deva ter “Morcego, ratazana, baratinha e companhia”.
Basicamente, nesse exemplo é um histórico de ligações, onde o atendente efetua uma ligação e registra no sistema, sendo que pode a ligação pode ser respondida também.
Abaixo os dados da tabela criada para a customização:
Tabela:
- SZA
Índices:
- ZA_FILIAL + ZA_CLIENTE + ZA_LOJA + DTOS(ZA_DATA) + ZA_HORA
Campos:
- ZA_FILIAL – Caracter – Tamanho padrão conforme empresa
- ZA_CLIENTE – Caracter – Tamanho do campo A1_COD
- ZA_LOJA – Caracter – Tamanho do campo A1_LOJA
- ZA_DATA – Data – Tamanho 8
- ZA_HORA – Caracter – Tamanho 8
- ZA_USER – Caracter – Tamanho 15
- ZA_MEMO – Memo – Tamanho automático
- ZA_STATUS – Caracter – Tamanho 1 – Opções P=Pendente;F=Finalizado;
- ZA_RESPOS – Caracter – Tamanho 26
Abaixo o fonte desenvolvido:
//Bibliotecas #include 'RwMake.ch' #Include 'TopConn.ch' #Include 'Ap5Mail.ch' #Include 'Protheus.ch' //Constantes #Define POS_CARGO 0001 #Define POS_RECNO 0002 #Define POS_RESPOS 0003 #Define POS_STATUS 0004 #Define POS_RECPAI 0005 //Estáticas Static aRelacao := {} Static nTamCarg := 6 Static nTamSubC := 3 /*/{Protheus.doc} zDbTree Histórico de ligações de Clientes @type function @author Atilio @since 09/03/2016 @version 1.0 @example u_zDbTree() @obs Ter a seguinte estrutura criada: Tabela: SZA Índices: 1 - ZA_FILIAL + ZA_CLIENTE + ZA_LOJA + DTOS(ZA_DATA) + ZA_HORA Campos: ZA_FILIAL - Caracter - Tamanho padrão conforme empresa ZA_DATA - Data - Tamanho 8 ZA_HORA - Caracter - Tamanho 8 ZA_USER - Caracter - Tamanho 15 ZA_MEMO - Memo - Tamanho automático ZA_STATUS - Caracter - Tamanho 1 - Opções P=Pendente;F=Finalizado; ZA_RESPOS - Caracter - Tamanho 26 /*/ User Function zDbTree() Local aArea := GetArea() Local nJanLarg := 800 Local nJanAltu := 500 Private lIncluir, lAlterar, lVisualizar, lExcluir Private oBtnInc, oBtnExc, oBtnAlt, oBtnVis, oBtnRes, oBtnFin Private cFilCli := FWxFilial("SA1") Private cCliente := SA1->A1_COD Private cLojaCli := SA1->A1_LOJA Private cNomRep := "Teste" //SA1->A1_NOME Private oTreePad Private oGetObs, cGetObs := "" Private lSoAberto := .F. lSoAberto := MsgYesNo("Deseja trazer somente as interações pendentes?", "Atenção") DbSelectArea("SZA") SZA->(DbSetOrder(1)) //ZA_FILIAL+ZA_CLIENTE+ZA_LOJA+DTOS(ZA_DATA)+ZA_HORA //Criando a janela DEFINE MSDIALOG oDlgRep TITLE "Contatos realizados com o Cliente" FROM 000, 000 TO nJanAltu, nJanLarg COLORS 0, 16777215 PIXEL @ 001, 001 Say "Cliente: "+cCliente+" - "+cNomRep of oDlgRep Pixel //Criando o DbTree oTreePad := dbTree():New(011,003,(nJanAltu/2)-79,(nJanLarg/2)-1,oDlgRep,{|| fAtuObs()},,.T.) //Monta os dados da Tree fMntTree() //Observação @ (nJanAltu/2)-76, 003 GROUP oGrpObs TO (nJanAltu/2)-26, (nJanLarg/2-003)-86 PROMPT "Observação: " OF oDlgRep COLOR 0, 16777215 PIXEL @ (nJanAltu/2)-70, 006 GET oGetObs VAR cGetObs SIZE (nJanLarg/2-003)-86-9, 040 OF oDlgRep MULTILINE COLORS 0, 16777215 HSCROLL PIXEL oGetObs:lReadOnly := .T. //Legenda @ (nJanAltu/2)-76, (nJanLarg/2-003)-83 GROUP oGrpLeg TO (nJanAltu/2)-26, (nJanLarg/2)-1 PROMPT "Legenda: " OF oDlgRep COLOR 0, 16777215 PIXEL @ (nJanAltu/2)-70, (nJanLarg/2-003)-80 BITMAP oBmpPend SIZE 012, 011 OF oDlgRep FILENAME "FOLDER5" NOBORDER ADJUST PIXEL @ (nJanAltu/2)-57, (nJanLarg/2-003)-80 BITMAP oBmpFina SIZE 012, 011 OF oDlgRep FILENAME "FOLDER14" NOBORDER ADJUST PIXEL @ (nJanAltu/2)-67, (nJanLarg/2-003)-62 SAY oSayPend PROMPT "Pendente" SIZE 040, 007 OF oDlgRep PIXEL @ (nJanAltu/2)-54, (nJanLarg/2-003)-62 SAY oSayFina PROMPT "Finalizado" SIZE 040, 007 OF oDlgRep PIXEL @ (nJanAltu/2)-23, 3 GROUP oGrpAco TO (nJanAltu/2)-3, (nJanLarg/2)-1 PROMPT "Ações: " OF oDlgRep COLOR 0, 16777215 PIXEL //Cria os botões @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*08) BUTTON "&Incluir" Size 040, 012 Action fOperacao(3) Object oBtnInc @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*07) BUTTON "&Alterar" Size 040, 012 Action fOperacao(4) Object oBtnAlt @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*06) BUTTON "&Visualizar" Size 040, 012 Action fOperacao(2) Object oBtnVis @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*05) BUTTON "&Excluir" Size 040, 012 Action fOperacao(5) Object oBtnExc @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*04) BUTTON "&Responder" Size 040, 012 Action fOperacao(6) Object oBtnRes @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*03) BUTTON "&Finalizar" Size 040, 012 Action fFinaliza() Object oBtnFin @ (nJanAltu/2)-17,(nJanLarg/2-003)-(0042*01) BUTTON "&Sair" Size 040, 012 Action (oDlgRep:End()) Object oBtnSai fMostBtn(lIncluir, lAlterar, lVisualizar ,lExcluir) ACTIVATE MSDIALOG oDlgRep CENTERED RestArea(aArea) Return Static Function fMostBtn(lI,lA,lV,lE) oBtnInc:lVisible := lI oBtnAlt:lVisible := lA oBtnVis:lVisible := lV oBtnExc:lVisible := lE If !lA oBtnRes:lVisible := .F. oBtnFin:lVisible := .F. EndIf Return Static Function fOperacao(nOpc) Local aArea := GetArea() Private dDataLig, cHoraLig Private cUser, cObs, cStatus, cRespos Private oDlgOper //Se for inclusão ou resposta If nOpc == 3 .Or. nOpc == 6 dDataLig := dDataBase cHoraLig := Time() cUser := Alltrim(cUserName) cObs := "" cStatus := "P" //Se for inclusão, apenas preenche em resposta de, em branco If nOpc == 3 cRespos := "" //Senão, preenche a resposta ElseIf nOpc == 6 cCargo := oTreePad:GetCargo() nEncont := aScan(aRelacao,{|x| x[POS_CARGO] == cCargo }) cRespos := aRelacao[nEncont][POS_RESPOS] //Se tiver finalizado, não permite responder If aRelacao[nEncont][POS_STATUS] == 'F' MsgAlert("Interação já finalizada, não é possível responder!", "Atenção") Return EndIf EndIf //Senão, preenche as variáveis Else cCargo := oTreePad:GetCargo() nEncont := aScan(aRelacao,{|x| x[POS_CARGO] == cCargo }) SZA->(DbGoTo(aRelacao[nEncont][POS_RECNO])) //Preenchendo os campos dDataLig := SZA->ZA_DATA cHoraLig := SZA->ZA_HORA cUser := SZA->ZA_USER cObs := SZA->ZA_MEMO cStatus := SZA->ZA_STATUS cRespos := SZA->ZA_RESPOS EndIf //Criando a janela DEFINE MSDIALOG oDlgOper TITLE "Ligação" FROM 000, 000 TO 330, 550 COLORS 0, 16777215 PIXEL //Labels @ 007, 005 SAY oSayData PROMPT "Data:" SIZE 040, 007 OF oDlgOper PIXEL @ 020, 005 SAY oSayHora PROMPT "Hora:" SIZE 040, 007 OF oDlgOper PIXEL @ 033, 005 SAY oSayUser PROMPT "Usuário:" SIZE 040, 007 OF oDlgOper PIXEL If nOpc == 3 @ 085, 005 SAY oSayStat PROMPT "Status:" SIZE 040, 007 OF oDlgOper PIXEL EndIf @ 098, 005 SAY oSayObse PROMPT "Observação:" SIZE 040, 007 OF oDlgOper PIXEL //Gets e Componentes @ 007, 040 MSGET oDataLig VAR dDataLig SIZE 040, 010 OF oDlgOper COLORS 0, 16777215 PIXEL @ 020, 040 MSGET oHoraLig VAR cHoraLig SIZE 040, 010 OF oDlgOper COLORS 0, 16777215 PIXEL @ 033, 040 MSGET oUser VAR cUser SIZE 040, 010 OF oDlgOper COLORS 0, 16777215 PIXEL If nOpc == 3 @ 085, 040 MSCOMBOBOX oStatus VAR cStatus ITEMS StrTokArr(GetSX3Cache('ZA_STATUS', 'X3_CBOX'), ';') SIZE 060, 010 OF oDlgOper COLORS 0, 16777215 PIXEL EndIf @ 098, 040 GET oMemoObs VAR cObs SIZE 230, 050 OF oDlgOper MULTILINE COLORS 0, 16777215 HSCROLL PIXEL //Botões @ 150, 173 BUTTON oBtnConf PROMPT "Confirmar" SIZE 048, 010 OF oDlgOper ACTION( Processa( {|| fConfirm(nOpc) } , "Processando...","Aguarde...", .T. ) ) PIXEL @ 150, 223 BUTTON oBtnCanc PROMPT "Cancelar" SIZE 048, 010 OF oDlgOper ACTION(oDlgOper:End()) PIXEL //Se for visualização ou exclusão If nOpc == 2 .Or. nOpc == 5 oDataLig:lReadOnly := .T. oHoraLig:lReadOnly := .T. oUser:lReadOnly := .T. oMemoObs:lReadOnly := .T. //Senão, libera os campos Else oDataLig:lReadOnly := .F. oHoraLig:lReadOnly := .F. oUser:lReadOnly := .F. oMemoObs:lReadOnly := .F. //Se for alteração, bloqueia campos chave If nOpc == 4 oDataLig:lReadOnly := .T. oHoraLig:lReadOnly := .T. oUser:lReadOnly := .T. EndIf EndIf ACTIVATE MSDIALOG oDlgOper CENTERED RestArea(aArea) Return Static Function fConfirm(nOpcao) //Se for visualização If nOpcao == 2 oDlgOper:End() //Se for inclusão ou resposta ElseIf nOpcao == 3 .Or. nOpcao == 6 //Data em branco If Empty(dDataLig) MsgAlert("Informe a data da ligação!", "Atenção") oDataLig:SetFocus() Return EndIf //Hora em branco If Empty(cHoraLig) MsgAlert("Informe a hora da ligação!", "Atenção") oHoraLig:SetFocus() Return EndIf //Usuário em branco If Empty(cUser) MsgAlert("Informe o usuário que manteve o contato!", "Atenção") oUser:SetFocus() Return EndIf //Observaão em branco If Empty(cObs) MsgAlert("Informe o motivo e/ou observação da ligação!", "Atenção") oMemoObs:SetFocus() Return EndIf //Se conseguir posicionar, registro já existe If SZA->(DbSeek(cFilCli+cCliente+dToS(dDataLig)+cHoraLig)) MsgAlert("Já existe ligação registrada pra esse Cliente, nessa data e hora.", "Atenção") Return Else RecLock("SZA", .T.) ZA_FILIAL := cFilCli ZA_CLIENTE := cCliente ZA_LOJA := cLojaCli ZA_DATA := dDataLig ZA_HORA := cHoraLig ZA_USER := cUser ZA_MEMO := cObs ZA_STATUS := cStatus ZA_RESPOS := cRespos SZA->(MsUnlock()) Endif oDlgOper:End() //Se for alteração ElseIf nOpcao == 4 RecLock("SZA",.F.) ZA_STATUS := cStatus ZA_MEMO := cObs SZA->(MsUnLock()) oDlgOper:End() //Se for exclusão ElseIf nOpcao == 5 cCargo := oTreePad:GetCargo() nEncont := 0 //Se tiver cargo If !Empty(cCargo) nEncont := aScan(aRelacao,{|x| x[POS_CARGO] == cCargo }) //Se conseguir encontrar o registro If nEncont > 0 //Se o recno do registro for o mesmo do pai, é uma interação, não uma resposta If aRelacao[nEncont][POS_RECNO] == aRelacao[nEncont][POS_RECPAI] //Pergunta se deseja realmente prosseguir com a exclusão If MsgYesNo("Essa interação pode possuir resposta(s), se prosseguir elas também serão excluídas.<br>Deseja continuar?", "Atenção") RecLock("SZA", .F.) SZA->(DbDelete()) SZA->(MsUnLock()) //Seleciona todas as respostas da interação cQryRes := " SELECT " cQryRes += " ZA.R_E_C_N_O_ AS ZAREC " cQryRes += " FROM " cQryRes += " "+RetSqlName("SZA")+" ZA WITH (NOLOCK) " cQryRes += " WHERE " cQryRes += " ZA_FILIAL = '" + cFilCli + "'" cQryRes += " AND ZA_CLIENTE = '" + cCliente + "'" cQryRes += " AND ZA_LOJA = '" + cLojaCli + "'" cQryRes += " AND ZA_RESPOS = '" + aRelacao[nEncont][POS_RESPOS] + "' " cQryRes += " AND ZA.D_E_L_E_T_ = ' '" cQryRes += " ORDER BY " cQryRes += " ZA_DATA DESC, ZA_HORA DESC" TCQuery cQryRes New Alias "QRY_RES" //Enquanto houver registros While ! QRY_RES->(EoF()) SZA->(DbGoTo(QRY_RES->ZAREC)) RecLock('SZA', .F.) SZA->(DbDelete()) SZA->(MsUnlock()) QRY_RES->(DbSkip()) EndDo QRY_RES->(DbCloseArea()) EndIf Else //Se tiver finalizado If SZA->ZA_STATUS == 'F' If ! MsgYesNo("Essa resposta já está finalizada, deseja prosseguir com a exclusão?", "Atenção") Return EndIf EndIf RecLock("SZA", .F.) SZA->(DbDelete()) SZA->(MsUnLock()) EndIf EndIf EndIf oDlgOper:End() EndIf //Se não for visualização, chama rotinas para atualizar o acols If nOpcao != 2 fMntTree() fMostBtn(lIncluir, lAlterar, lVisualizar, lExcluir) EndIf Return Static Function fMntTree() Local aArea := GetArea() Local nRaiz := 1 Local nItem := 0 Local cCargoAtu := "" Local cSubCargo := "" Local cFolder01 := "" Local cFolder02 := "" Local cResposta := "" DbSelectArea("SZA") SZA->(DbSetOrder(1)) // Filial + Cliente + Data + Hora SZA->(DbGoTop()) //Zerando variáveis lIncluir := .T. lAlterar := .T. lVisualizar := .T. lExcluir := .T. //Retirando todos os nós oTreePad:Reset() aRelacao := {} //Se conseguir posicionar na filial e Cliente If SZA->(DbSeek(cFilCli+cCliente)) //Monta uma consulta para pegar todos os dados cQuery := " SELECT " cQuery += " *, ZA.R_E_C_N_O_ AS ZAREC " cQuery += " FROM " cQuery += " "+RetSqlName("SZA")+" ZA WITH (NOLOCK) " cQuery += " WHERE " cQuery += " ZA_FILIAL = '" + cFilCli + "'" cQuery += " AND ZA_CLIENTE = '" + cCliente + "'" cQuery += " AND ZA_LOJA = '" + cLojaCli + "'" cQuery += " AND ZA_RESPOS = ' ' " cQuery += " AND ZA.D_E_L_E_T_ = ' '" If lSoAberto cQuery += " AND ZA_STATUS != 'F' " EndIf cQuery += " ORDER BY " cQuery += " ZA_DATA DESC, ZA_HORA DESC" TCQuery cQuery New Alias "QSZA" TcSetField("QSZA","ZA_DATA","D") //Se tiver dados atualiza a observação conforme o primeiro registro If !QSZA->(EoF()) SZA->(DbGoTo(QSZA->ZAREC)) cGetObs := SZA->ZA_MEMO //Enquanto houver registros, adiciona no TREE While !QSZA->(EoF()) nItem := 0 cCargoAtu := StrZero(nRaiz, nTamCarg) cSubCargo := StrZero(nItem, nTamSubC) cResposta := FWxFilial('SZA') + QSZA->ZA_CLIENTE + QSZA->ZA_LOJA + dToS(QSZA->ZA_DATA) + QSZA->ZA_HORA //Se for pendente, a pasta será amarela If QSZA->ZA_STATUS == 'P' cFolder01 := 'FOLDER5' cFolder02 := 'FOLDER6' //Senão, será preta Else cFolder01 := 'FOLDER14' cFolder02 := 'FOLDER15' EndIf //Cria a pasta da ligação para o Cliente oTreePad:AddTree("Interação - Data: "+dToC(QSZA->ZA_DATA)+", Hora: "+QSZA->ZA_HORA+", Por: "+QSZA->ZA_USER+Space(50), .T., cFolder01, cFolder02, , , cCargoAtu+"."+cSubCargo) aAdd(aRelacao, {cCargoAtu+"."+cSubCargo, QSZA->ZAREC, cResposta, QSZA->ZA_STATUS, QSZA->ZAREC}) //Seleciona todas as respostas da interação cQryRes := " SELECT " cQryRes += " *, ZA.R_E_C_N_O_ AS ZAREC " cQryRes += " FROM " cQryRes += " "+RetSqlName("SZA")+" ZA WITH (NOLOCK) " cQryRes += " WHERE " cQryRes += " ZA_FILIAL = '" + cFilCli + "'" cQryRes += " AND ZA_CLIENTE = '" + cCliente + "'" cQryRes += " AND ZA_LOJA = '" + cLojaCli + "'" cQryRes += " AND ZA_RESPOS = '" + cResposta + "' " cQryRes += " AND ZA.D_E_L_E_T_ = ' '" cQryRes += " ORDER BY " cQryRes += " ZA_DATA DESC, ZA_HORA DESC" TCQuery cQryRes New Alias "QRY_RES" TcSetField("QRY_RES","ZA_DATA","D") nItem++ //Enquanto houver respostas While ! QRY_RES->(EoF()) cSubCargo := StrZero(nItem, nTamSubC) oTreePad:AddTreeItem("Resposta - Data: "+dToC(QRY_RES->ZA_DATA)+", Hora: "+QRY_RES->ZA_HORA+", Por: "+QRY_RES->ZA_USER+Space(50), "", , cCargoAtu+"."+cSubCargo) aAdd(aRelacao, {cCargoAtu+"."+cSubCargo, QRY_RES->ZAREC, cResposta, QSZA->ZA_STATUS, QSZA->ZAREC}) nItem++ QRY_RES->(DbSkip()) EndDo QRY_RES->(DbCloseArea()) oTreePad:EndTree() nRaiz++ QSZA->(DbSkip()) EndDo Else lIncluir := .T. lAlterar := .F. lVisualizar := .F. lExcluir := .F. EndIf QSZA->(DbCloseArea()) Else lIncluir := .T. lAlterar := .F. lVisualizar := .F. lExcluir := .F. EndIf oTreePad:Refresh() RestArea(aArea) Return Static Function fFinaliza() Local aArea := GetArea() Local cCargo := oTreePad:GetCargo() Local nEncont := 0 If MsgYesNo("Deseja finalizar a interação?", "Atenção") //Se tiver cargo If !Empty(cCargo) nEncont := aScan(aRelacao,{|x| x[POS_CARGO] == cCargo }) //Se conseguir encontrar o registro If nEncont > 0 //Posiciona no registro pai SZA->(DbGoTo(aRelacao[nEncont][POS_RECPAI])) //Esta interação já está finalizada If SZA->ZA_STATUS == 'F' MsgAlert("Essa interação já está finalizada!", "Atenção") //Senão, finaliza a interação, e das respostas Else RecLock('SZA', .F.) ZA_STATUS := 'F' SZA->(MsUnlock()) //Seleciona todas as respostas da interação cQryRes := " SELECT " cQryRes += " ZA.R_E_C_N_O_ AS ZAREC " cQryRes += " FROM " cQryRes += " "+RetSqlName("SZA")+" ZA WITH (NOLOCK) " cQryRes += " WHERE " cQryRes += " ZA_FILIAL = '" + cFilCli + "'" cQryRes += " AND ZA_CLIENTE = '" + cCliente + "'" cQryRes += " AND ZA_LOJA = '" + cLojaCli + "'" cQryRes += " AND ZA_RESPOS = '" + aRelacao[nEncont][POS_RESPOS] + "' " cQryRes += " AND ZA.D_E_L_E_T_ = ' '" cQryRes += " ORDER BY " cQryRes += " ZA_DATA DESC, ZA_HORA DESC" TCQuery cQryRes New Alias "QRY_RES" //Enquanto houver registros While ! QRY_RES->(EoF()) SZA->(DbGoTo(QRY_RES->ZAREC)) RecLock('SZA', .F.) ZA_STATUS := 'F' SZA->(MsUnlock()) QRY_RES->(DbSkip()) EndDo QRY_RES->(DbCloseArea()) MsgInfo("Interação Finalizada!", "Atenção") fMntTree() EndIf EndIf EndIf EndIf RestArea(aArea) Return Static Function fAtuObs() Local aArea := GetArea() Local cCargo := oTreePad:GetCargo() Local nEncont := 0 cGetObs := "" //Se tiver cargo If !Empty(cCargo) nEncont := aScan(aRelacao,{|x| x[1] == cCargo }) //Se conseguir encontrar o registro If nEncont > 0 //Posiciona no registro SZA->(DbGoTo(aRelacao[nEncont][POS_RECNO])) cGetObs := SZA->ZA_MEMO EndIf EndIf oGetObs:Refresh() RestArea(aArea) Return
Bom pessoal, por hoje é só.
Abraços e até a próxima.
Boa tarde!
Bela dica para quem está aprendendo, gostaria de saber como faço para adicionar mais um campo no caso para digitar o nome do cliente?
Grato
Boa tarde.
Obrigado pelo comentário.
Você deve adicionar o campo no configurador, e mexer na Dialog entre as linhas 164 até 208 para adicionar um MSGET, e depois adicionar esse campo no reclock.