× Linguagem de Programação ADVPL

Perguntas Função para preencher msselect

Mais
7 anos 6 meses atrás #32143 por Marco Antonio
Boa tarde a todos
Tenho um exemplo de MsSelect que preenche dados de um arquivo de trabalho.
Tenho um botão, que realiza uma query e preenche o MsSelect. O problema é que se eu tento preencher novamente, ele duplica os dados na MsSelect.
Creio que eu deva limpar os dados do arquivo de trabalho, para que a query grave novamente, mas não sei como proceder.
Já tentei um loop com dbdelete() e depois um pack(), mas dá erro de acesso exclusivo. E se eu crio o arquivo de trabalho em modo exclusivo ou uso a função abreexcl() também não funciona.
Caso alguém possa me indicar uma outra forma de fazer isso, ou seja, sempre que eu chamar a função de preenchiumento de dados, ele apagar os anteriores e trazer novos. Obrigado!
Segue código:

#include "protheus.ch"

User Function Teste2()
Local oDlg

Private _stru:={}
Private aCpoBro := {}
Private aCores := {}
Private lInverte := .F.
Private cMark := GetMark()
Private oMark
Private cArq

fTrab()

DEFINE MSDIALOG oDlg TITLE "MarkBrowse c/Refresh" From 9,0 To 315,800 PIXEL

DbSelectArea("TTRB")
DbGotop()

//Cria a MsSelect
oMark := MsSelect():New("TTRB","OK","",aCpoBro,@lInverte,@cMark,{17,1,150,400},,,,,aCores)
oMark:bMark := {| | Disp()}

oDlg:lMaximized:= .T.

//Exibe a Dialog
ACTIVATE MSDIALOG oDlg CENTERED ON INIT EnchoiceBar(oDlg,{|| fTrab()},{|| oDlg:End()})

//Fecha a Area e elimina os arquivos de apoio criados em disco.
TTRB->(DbCloseArea())
Iif(File(cArq + GetDBExtension()),FErase(cArq + GetDBExtension()) ,Nil)


Return()

//Cria uma Dialog
Static Function fTrab()

//Cria um arquivo de Apoio
AADD(_stru,{"OK" ,"C" ,2 ,0 })
AADD(_stru,{"COD" ,"C" ,6 ,0 })
AADD(_stru,{"LOJA" ,"C" ,2 ,0 })
AADD(_stru,{"NOME" ,"C" ,40 ,0 })
AADD(_stru,{"ENDER" ,"C" ,40 ,0 })
AADD(_stru,{"SITUA" ,"C" ,1 ,0 })

cArq:=Criatrab(_stru,.T.)
DBUSEAREA(.t.,,carq,"TTRB")

DbSelectArea("TTRB")
RecLock("TTRB",.T.)
TTRB->COD := "123456"
TTRB->LOJA:= "12"
TTRB->NOME:= "NOME TESTE"
TTRB->ENDER:= "RUA TESTE, 200"
TTRB->SITUA := "0"
MsUnlock()

//Define as cores dos itens de legenda.

aCores := {}
aAdd(aCores,{"TTRB->SITUA == '0'","BR_VERDE" })
aAdd(aCores,{"TTRB->SITUA == '1'","BR_AMARELO" })
aAdd(aCores,{"TTRB->SITUA == '2'","BR_VERMELHO"})

//Define quais colunas (campos da TTRB) serao exibidas na MsSelect
aCpoBro := {{ "OK" ,, "Mark" ,"@!"},;
{ "COD" ,, "Codigo" ,"@!"},;
{ "LOJA" ,, "Loja" ,"@1!"},;
{ "NOME" ,, "Nome" ,"@X"},;
{ "ENDER" ,, "Endereco" ,"@!"}}

Return()








//Funcao executada ao Marcar/Desmarcar um registro.
Static Function Disp()
RecLock("TTRB",.F.)
If Marked("OK")
TTRB->OK := cMark
Else
TTRB->OK := ""
Endif
MSUNLOCK()
oMark:oBrowse:Refresh()

Return()

Por favor Acessar ou Registrar para participar da conversa.

Mais
7 anos 6 meses atrás #32144 por kanaamlrr
Respondido por kanaamlrr no tópico Função para preencher msselect
Se você usar o dbDelete() já deve resolver...
Você poderia mandar o fonte completo de como está hoje?
Abraço!

Por favor Acessar ou Registrar para participar da conversa.

Mais
7 anos 6 meses atrás #32145 por Marco Antonio
Olá!
Nesse meio tempo, eu fiz um teste com o criatrab() e constatei que quando fecha a tabela (dbclosearea()) e apaga o arquivo temporario (fErase(carq+getdbextension()), a tabela não existe mais. Me parece que esses dados continuam ativos por estarem contidos no MsSelect. Então estou aqui me perguntando se não é questão de esvaziar o Msselect. Procurei documentação das propriedades do MsSelect, mas não achei nada além do construtor.
Quanto ao DbDelete, já tentei também, mas o MsSelect preenche novamente sem apagar o registro que já estava antes do refresh, dando mais um indício do MsSelect manter os dados. Segue meu código:

#INCLUDE "PROTHEUS.CH"
#INCLUDE "TOPCONN.CH"

User Function teste()

Local oDlg
Local cCliente := Space(TamSx3("A1_COD")[1])
Local cLojaIni := Space(TamSx3("A1_LOJA")[1])
Local cLojaFin := Space(TamSx3("A1_LOJA")[1])
Local cTs := Space(TamSx3("F4_CODIGO")[1])
Local cMsg := Space(TamSx3("M4_CODIGO")[1])
Local dDtIni := ctod(" / / ")
Local dDtFin := ctod(" / / ")
Local aCpoBro := {}
Local aCores := {}
Local _stru:={}
Local cDescCli := Space(TamSx3("A1_NOME")[1])
Private lInverte := .T.
Private cMark := GetMark()
Private oMark

//Cria um arquivo de Apoio
AADD(_stru,{"OK" ,"C" ,2 ,0 })
AADD(_stru,{"DTPRO" ,"D" ,8 ,0 })
AADD(_stru,{"NRPRO" ,"C" ,9 ,0 })
AADD(_stru,{"NROS" ,"C" ,9 ,0 })
AADD(_stru,{"TIPCON" ,"C" ,1 ,0 })
AADD(_stru,{"SERV" ,"C" ,30 ,0 })
AADD(_stru,{"DESCSRV","C" ,30 ,0 })
AADD(_stru,{"QTDSRV" ,"N" ,9 ,0 })
AADD(_stru,{"VLRCLI" ,"N" ,12 ,2 })
AADD(_stru,{"DTCLI" ,"D" ,8 ,0 })
AADD(_stru,{"CLIENT" ,"C" ,6 ,0 })
AADD(_stru,{"LOJA" ,"C" ,4 ,0 })
AADD(_stru,{"NOMCLI" ,"C" ,40 ,0 })
AADD(_stru,{"BLOQ" ,"C" ,1 ,0 })
AADD(_stru,{"CHAVE" ,"C" ,6 ,0 })
AADD(_stru,{"DESCRI" ,"C" ,55 ,0 })
AADD(_stru,{"CMEMO" ,"M" ,10 ,0 })
AADD(_stru,{"MARCA" ,"C" ,1 ,0 })

cArq:=Criatrab(_stru,.T.)
DBUSEAREA(.t.,,cArq,"TTRB")

aCores := {}
aAdd(aCores,{"TTRB->MARCA == '0'","BR_VERDE" })
aAdd(aCores,{"TTRB->MARCA == '1'","BR_AMARELO" })
aAdd(aCores,{"TTRB->MARCA == '2'","BR_VERMELHO" })

aCpoBro := {{ "OK" ,, "Mark" ,"@!"},;
{ "DTPRO" ,, "Data Protocolo" ,"@!"},;
{ "NRPRO" ,, "Nr. Protocolo" ,"@!"},;
{ "NROS" ,, "Nr. OS" ,"@!"},;
{ "TIPCON" ,, "Tp. Contrato" ,"@!"},;
{ "SERV" ,, "Servico" ,"@!"},;
{ "DESCSRV" ,, "Descricao" ,"@!"},;
{ "QTDSRV" ,, "Qtde" ,"999999999"},;
{ "VLRCLI" ,, "Val. cliente" ,"@E 999,999,999.99"},;
{ "DTCLI" ,, "Data cliente" ,"@!"},;
{ "CLIENT" ,, "Cod. Cliente" ,"@!"},;
{ "LOJA" ,, "Loja Cliente" ,"@!"},;
{ "NOMCLI" ,, "Nome Cliente" ,"@!"},;
{ "BLOQ" ,, "Bloqueado" ,"@!"},;
{ "CHAVE" ,, "Chave" ,"@!"},;
{ "DESCRI" ,, "Descricao" ,"@!"},;
{ "CMEMO" ,, "Observacoes" }}

DEFINE MSDIALOG oDlg TITLE "Faturamento Agenda Tecnica" FROM 000,000 TO 500,500 OF oMainWnd PIXEL

@ 10,10 SAY "Cliente" SIZE 50 ,10 PIXEL OF oDlg
@ 10,50 MSGET cCliente SIZE 35 ,10 PIXEL OF oDlg F3 "SA1" VALID fRetNome(cCliente) HASBUTTON
@ 10,100 SAY "Loja Inicial" SIZE 50 ,10 PIXEL OF oDlg
@ 10,135 MSGET cLojaIni SIZE 25 ,10 PIXEL OF oDlg
@ 10,175 MSGET cDescCli SIZE 200,10 PIXEL OF oDlg WHEN .F.
@ 25,100 SAY "Loja Final" SIZE 50 ,10 PIXEL OF oDlg
@ 25,135 MSGET cLojaFin SIZE 25 ,10 PIXEL OF oDlg
@ 40,10 SAY "Data Inicial" SIZE 50 ,10 PIXEL OF oDlg
@ 40,50 MSGET dDtIni SIZE 50 ,10 PIXEL OF oDlg PICTURE "@D" HASBUTTON
@ 40,100 SAY "Data final" SIZE 50 ,10 PIXEL OF oDlg
@ 40,135 MSGET dDtFin SIZE 50 ,10 PIXEL OF oDlg PICTURE "@D" HASBUTTON
@ 55,10 SAY "Tipo Saida" SIZE 50 ,10 PIXEL OF oDlg
@ 55,50 MSGET cTs SIZE 25 ,10 PIXEL OF oDlg F3 "SF4" VALID fValidaTes(cTs) HASBUTTON
@ 55,100 SAY "Msg Padrao" SIZE 50 ,10 PIXEL OF oDlg
@ 55,135 MSGET cMsg SIZE 25 ,10 PIXEL OF oDlg F3 "SM4" HASBUTTON
@ 55,175 BUTTON "Listar Servicos" SIZE 50,15 PIXEL OF oDlg ACTION (fListaExame(cCliente,cLojaIni,cLojaFin,dDtIni,dDtFin))

lCheck := .f.
oCheck := IW_CheckBox(55,250,"Marca/Desmarca Todos","lCheck")
oCheck:bChange := {|| MsAguarde( {|| fTudo() } ) }

DbSelectArea("TTRB")
DbGotop()

oMark := MsSelect():New("TTRB","OK","",aCpoBro,@lInverte,@cMark,{100,10,400,900},,,oDlg,,aCores)
oMark:bMark := {| | Disp()}

oDlg:lMaximized:= .T.

ACTIVATE MSDIALOG oDlg CENTERED

TTRB->(DbCloseArea())
Iif(File(cArq + GetDBExtension()),FErase(cArq + GetDBExtension()) ,Nil)

Return

//=================================================================================================

Static Function fListaExame(cCli,cLjI,cLjF,dDtI,dDtf)

Local cSQL := ""
Local cAlias := "TMPTRAB"
Local cMemo
Local cObs := ""

cSQL:= "SELECT ZOD_DTPRO, ZOD_NRPRO, ZOD_NROS, CASE ZOD_TIPCON WHEN '1' THEN 'OS' WHEN '2' THEN 'RENOVACAO' WHEN '3' THEN 'INAUGURACAO' WHEN '4' THEN 'CI' END TIPO, "
cSQL+= "ZOE_SERV, B1_DESC, ZOE_QTDE, ZOE_VLCLI, ZOE_DTCLI, ZOD_CLIENT, ZOD_LOJA, A1_NOME, CASE A1_MSBLQL WHEN '1' THEN 'BLOQUEADO' WHEN '2' THEN 'ATIVO' END SITUACAO, X5_CHAVE, X5_DESCRI FROM "+RetSqlName("ZOE")+" ZOE "
cSQL+= "INNER JOIN "+RetSqlName("ZOD")+" ZOD ON ZOE_NRPRO = ZOD_NRPRO "
cSQL+= "AND ZOD_CLIENT >= '000000' AND ZOD_CLIENT <= 'ZZZZZZ' AND ZOD_LOJA >= '0000' AND ZOD_LOJA <= 'ZZZZ' AND ZOD.D_E_L_E_T_ = '' "
cSQL+= "INNER JOIN "+RetSqlName("SA1")+" SA1 ON ZOD_CLIENT = A1_COD AND ZOD_LOJA = A1_LOJA AND SA1.D_E_L_E_T_ = '' "
cSQL+= "INNER JOIN "+RetSqlName("SB1")+" SB1 ON ZOE_SERV = B1_COD AND SB1.D_E_L_E_T_ = '' "
cSQL+= "LEFT JOIN "+RetSqlName("SX5")+" SX5 ON X5_TABELA = 'Z5' AND X5_CHAVE = ZOE_STATOP AND SX5.D_E_L_E_T_ = '' "
cSQL+= "WHERE ZOE.D_E_L_E_T_ = '' AND ZOE_DTCLI BETWEEN '20160101' AND '20170120' ORDER BY ZOD_DTPRO, ZOD_CLIENT, ZOD_LOJA, ZOE_DTCLI"

cSQL := ChangeQuery(cSQL)
dbUseArea( .T., "TOPCONN", TCGENQRY(,,cSQL),cAlias, .F., .T.)
dbSelectArea(cAlias)
dbGotop()
While (cAlias)->(!EOF())
cMemo := Posicione("ZOE",1,xFilial("ZOE")+(cAlias)->ZOD_NRPRO,"ZOE->ZOE_OBSOPE")
If !Empty(cMemo)
For i := 1 to MlCount(cMemo,40)
cObs += MemoLine(cMemo,40,i)
Next i
Endif
TTRB->(DbSelectArea("TTRB"))
TTRB->(RecLock("TTRB",.T.))
TTRB->MARCA := "0"
TTRB->DTPRO := STOD((cAlias)->ZOD_DTPRO)
TTRB->NRPRO := (cAlias)->ZOD_NRPRO
TTRB->NROS := (cAlias)->ZOD_NROS
TTRB->TIPCON := (cAlias)->TIPO
TTRB->SERV := (cAlias)->ZOE_SERV
TTRB->DESCSRV := (cAlias)->B1_DESC
TTRB->QTDSRV := (cAlias)->ZOE_QTDE
TTRB->VLRCLI := (cAlias)->ZOE_VLCLI
TTRB->DTCLI := STOD((cAlias)->ZOE_DTCLI)
TTRB->CLIENT := (cAlias)->ZOD_CLIENT
TTRB->LOJA := (cAlias)->ZOD_LOJA
TTRB->NOMCLI := (cAlias)->A1_NOME
TTRB->BLOQ := (cAlias)->SITUACAO
TTRB->CHAVE := (cAlias)->X5_CHAVE
TTRB->DESCRI := (cAlias)->X5_DESCRI
TTRB->CMEMO := cObs
TTRB->(MsunLock())
(cAlias)->(DbSkip())
EndDo

(cAlias)->(DbCloseArea())

DbSelectArea("TTRB")
DbGotop()

TTRB->(DbCloseArea())
Iif(File(cArq + GetDBExtension()),FErase(cArq + GetDBExtension()) ,Nil)

oMark:oBrowse:Refresh()

Return

//================================================================================

// Função para retornar o nome do cliente
Static Function fRetNome(cCli)

Local lRet:= .F.
Local cRet:= Posicione("SA1",1,xFilial("SA1")+cCli,"SA1->A1_NOME")

If !Empty(cRet)
cDescCli := cRet
lRet:= .T.
Endif

Return lRet

//============================================================================

//Função para validar TES (apenas TES de saída)

Static Function fValidaTes(cTes)

Local lRet := .T.
Local cRet := Posicione("SF4",1,xFilial("SF4")+cTes,"SF4->F4_TIPO")

If cRet <> "S"
lRet:= .F.
Msginfo("O codigo informado deve ser do tipo saida")
Endif

Return lRet

//===============================================================================

//Funcao executada ao Marcar/Desmarcar um registro.
Static Function Disp()

RecLock("TTRB",.F.)
If Marked("OK")
TTRB->OK := cMark
Else
TTRB->OK := ""
Endif
MSUNLOCK()

oMark:oBrowse:Refresh()

Return()

//================================================================================

// Marca/Desmarca todos os itens do Browse...

Static Function fTudo()
TTRB->(dbGoTop())
While !TTRB->(Eof())
RecLock("TTRB",.f.)
If lCheck == .f.
TTRB->OK := ''
Else
TTRB->OK := cMark
EndIf
TTRB->(MsUnLock())
TTRB->(dbSkip())
Enddo
TTRB->(dbCommit())
TTRB->(dbGoTop())

oMark:oBrowse:Refresh()

Return

Por favor Acessar ou Registrar para participar da conversa.

Mais
7 anos 6 meses atrás #32146 por kanaamlrr
Respondido por kanaamlrr no tópico Função para preencher msselect
Tente substituir a função fListaExame pela abaixo
Static Function fListaExame(cCli,cLjI,cLjF,dDtI,dDtf)

Local cSQL := ""
Local cAlias := "TMPTRAB"
Local cMemo
Local cObs := ""

cSQL:= "SELECT ZOD_DTPRO, ZOD_NRPRO, ZOD_NROS, CASE ZOD_TIPCON WHEN '1' THEN 'OS' WHEN '2' THEN 'RENOVACAO' WHEN '3' THEN 'INAUGURACAO' WHEN '4' THEN 'CI' END TIPO, "
cSQL+= "ZOE_SERV, B1_DESC, ZOE_QTDE, ZOE_VLCLI, ZOE_DTCLI, ZOD_CLIENT, ZOD_LOJA, A1_NOME, CASE A1_MSBLQL WHEN '1' THEN 'BLOQUEADO' WHEN '2' THEN 'ATIVO' END SITUACAO, X5_CHAVE, X5_DESCRI FROM "+RetSqlName("ZOE")+" ZOE "
cSQL+= "INNER JOIN "+RetSqlName("ZOD")+" ZOD ON ZOE_NRPRO = ZOD_NRPRO "
cSQL+= "AND ZOD_CLIENT >= '000000' AND ZOD_CLIENT <= 'ZZZZZZ' AND ZOD_LOJA >= '0000' AND ZOD_LOJA <= 'ZZZZ' AND ZOD.D_E_L_E_T_ = '' "
cSQL+= "INNER JOIN "+RetSqlName("SA1")+" SA1 ON ZOD_CLIENT = A1_COD AND ZOD_LOJA = A1_LOJA AND SA1.D_E_L_E_T_ = '' "
cSQL+= "INNER JOIN "+RetSqlName("SB1")+" SB1 ON ZOE_SERV = B1_COD AND SB1.D_E_L_E_T_ = '' "
cSQL+= "LEFT JOIN "+RetSqlName("SX5")+" SX5 ON X5_TABELA = 'Z5' AND X5_CHAVE = ZOE_STATOP AND SX5.D_E_L_E_T_ = '' "
cSQL+= "WHERE ZOE.D_E_L_E_T_ = '' AND ZOE_DTCLI BETWEEN '20160101' AND '20170120' ORDER BY ZOD_DTPRO, ZOD_CLIENT, ZOD_LOJA, ZOE_DTCLI"

cSQL := ChangeQuery(cSQL)
dbUseArea( .T., "TOPCONN", TCGENQRY(,,cSQL),cAlias, .F., .T.)
dbSelectArea(cAlias)
dbGotop()

TTRB->(dbZap())

While (cAlias)->(!EOF())
cMemo := Posicione("ZOE",1,xFilial("ZOE")+(cAlias)->ZOD_NRPRO,"ZOE->ZOE_OBSOPE")
If !Empty(cMemo)
For i := 1 to MlCount(cMemo,40)
cObs += MemoLine(cMemo,40,i)
Next i
Endif
TTRB->(DbSelectArea("TTRB"))
TTRB->(RecLock("TTRB",.T.))
TTRB->MARCA	:= "0"
TTRB->DTPRO := STOD((cAlias)->ZOD_DTPRO)
TTRB->NRPRO := (cAlias)->ZOD_NRPRO
TTRB->NROS := (cAlias)->ZOD_NROS
TTRB->TIPCON := (cAlias)->TIPO
TTRB->SERV	:= (cAlias)->ZOE_SERV
TTRB->DESCSRV := (cAlias)->B1_DESC
TTRB->QTDSRV := (cAlias)->ZOE_QTDE
TTRB->VLRCLI := (cAlias)->ZOE_VLCLI
TTRB->DTCLI := STOD((cAlias)->ZOE_DTCLI)
TTRB->CLIENT := (cAlias)->ZOD_CLIENT
TTRB->LOJA := (cAlias)->ZOD_LOJA
TTRB->NOMCLI := (cAlias)->A1_NOME
TTRB->BLOQ := (cAlias)->SITUACAO
TTRB->CHAVE := (cAlias)->X5_CHAVE
TTRB->DESCRI := (cAlias)->X5_DESCRI
TTRB->CMEMO	:= cObs
TTRB->(MsunLock())
(cAlias)->(DbSkip())
EndDo

(cAlias)->(DbCloseArea())

DbSelectArea("TTRB")
DbGotop()

oMark:oBrowse:Refresh()

Return

Você só deve realizar um dbCloseArea no TTRB no final do seu programa, caso contrário o arquivo não existirá mais e não será possível manipulá-lo.
Abraço!

Por favor Acessar ou Registrar para participar da conversa.

Mais
7 anos 6 meses atrás #32148 por Marco Antonio
Bom dia!
Substituí a função, mas dá o erro "InterFunctionCall: Cannot find Function DbZAP in AppMap"

Será que falta algum include? ou A base está desatualizada?

Por favor Acessar ou Registrar para participar da conversa.

Mais
7 anos 6 meses atrás #32149 por Marco Antonio
Tentei usar a função __DbZap (ttrb->(__DbZap()), mas dá erro porque pede acesso exclusivo.

Por favor Acessar ou Registrar para participar da conversa.

Tempo para a criação da página:0.105 segundos
Joomla templates by a4joomla