Comando FOR EACH...IN...NEXT

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Responder
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Comando FOR EACH...IN...NEXT

Mensagem por JoséQuintas »

Mais um, este é mais "profundo"...

Código: Selecionar todos

   cNomeCertificado := "CORDEIRO"
   oCapicomStore := Win_OleCreateObject( "CAPICOM.Store" )
   oCapicomStore:Open( _CAPICOM_CURRENT_USER_STORE, "My", _CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED )
   oColecao := oCapicomStore:Certificates()
   FOR nCont = 1 TO oColecao:Count()
      IF cNomeCertificado $ oColecao:Item( nCont ):SubjectName
         oCertificado := oColecao:Item( nCont )
         ? oCertificado:ValidFromDate()
         ? oCertificado:ValidToDate()
         EXIT
      ENDIF
   NEXT
   RETURN

Código: Selecionar todos

   cNomeCertificado := "CORDEIRO"
   oCapicomStore := Win_OleCreateObject( "CAPICOM.Store" )
   oCapicomStore:Open( _CAPICOM_CURRENT_USER_STORE, "My", _CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED )
   FOR EACH oElement IN oCapicomStore:Certificates()
      IF cNomeCertificado $ oElement:SubjectName
         ? oElement:ValidFromDate()
         ? oElement:ValidToDate()
         EXIT
      ENDIF
   NEXT
   RETURN
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Comando FOR EACH...IN...NEXT

Mensagem por JoséQuintas »

Pra quem achou que aquele FOR/EACH pra Hash foi uma maravilha por reduzir de 100 linhas pra 30....

Código: Selecionar todos

cItemICMSST := XmlNode( cItem, "ICMSST" )
::aItemICMSST := hb_Hash()
FOR EACH oElement IN { "orig", "CST", "vBCSTRet", "vICMSSTRet", "vBCSTDest", "vICMSSTDest" }
     ::aItemICMSST[ oElement ] := XmlNode( cItemIcmsSt, oElement )
NEXT
cItemICMSSN101 := XmlNode( cItem, "ICMSSN101" )
::aItemICMSSN101 := hb_Hash()
FOR EACH oElement IN { "orig", "CSOSN", "pCredSN", "vCredICMSSN" }
     ::aItemICMSSN101[ oElement ] := XmlNOde( cItemIcmsSN101, oElement )
NEXT
cItemICMSSN102 := XmlNode( cItem, "ICMSSN102" )
::aItemICMSSN102 := hb_Hash()
FOR EACH oElement IN { "orig", "CSOSN" }
      ::aItemICMSSN102[ oElement ] := XmlNode( cItemIcmsSN102, oElement )
NEXT
cItemICMSSN201 := XmlNode( cItem, "ICMSSN201" )
::aItemICMSSN201 := hb_Hash()
FOR EACH oElement IN { "orig", "CSOSN", "modBCST", "pMVAST", "pRedBCST", "vBCST", "pICMSST", "vICMSST", "pCredSN", "vCredICMSSN" }
      ::aItemICMSSN201[ oElement ] := XmlNode( cItemIcmsSN201, oElement )
NEXT
cItemICMSSN202 := XmlNode( cItem, "ICMSSN202" )
::aItemICMSSN202 := hb_Hash()
FOR EACH oElement IN { "orig", "CSOSN", "modBCST", "pMVAST", "pRedBCST", "vBCST", "pICMSST", "vICMSST" }
      ::aItemIcmsSN202[ oElement ] := XmlNode( cItemIcmsSN202, oElement )
NEXT
cItemICMSSN500 := XmlNode( cItem, "ICMSSN500" )
::aItemICMSSN500 := hb_Hash()
FOR EACH oElement IN { "orig", "CSOSN", "vBCSTRet", "vICMSSTRet" }
      ::aItemICMSSN500[ oElement ] := XmlNode( cItemIcmsSN500, oElement )
NEXT
Que tal reduzir pra 6 linhas?

Código: Selecionar todos

   ::aItemICMSST    := XmlToHash( XmlNode( cItem, "ICMSST" ), { "orig", "CST", "vBCSTRet", "vICMSSTRet", "vBCSTDest", "vICMSSTDest" } )
   ::aItemICMSSN101 := XmlToHash( XmlNode( cItem, "ICMSSN101" ), { "orig", "CSOSN", "pCredSN", "vCredICMSSN" } )
   ::aItemICMSSN102 := XmlToHash( XmlNode( cItem, "ICMSSN102" ), { "orig", "CSOSN" } )
   ::aItemICMSSN201 := XmlToHash( XmlNode( cItem, "ICMSSN201" ), { "orig", "CSOSN", "modBCST", "pMVAST", "pRedBCST", "vBCST", "pICMSST", "vICMSST", "pCredSN", "vCredICMSSN" } )
   ::aItemICMSSN202 := XmlToHash( XmlNode( cItem, "ICMSSN202" ), { "orig", "CSOSN", "modBCST", "pMVAST", "pRedBCST", "vBCST", "pICMSST", "vICMSST" } )
   ::aItemICMSSN500 := XmlToHash( XmlNode( cItem, "ICMSSN500" ), { "orig", "CSOSN", "vBCSTRet", "vICMSSTRet" } )

STATIC FUNCTION XmlToHash( cXml, aTagList )

   LOCAL oElement, oVar := hb_Hash()

   FOR EACH oElement IN aTagList
      oVar[ oElement ] := XmlNode( cXml, oElement )
   NEXT

   RETURN oVar
Notem que apenas usei uma função pra substituir o que estava se repetindo por todo fonte.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
deividdjs
Usuário Nível 3
Usuário Nível 3
Mensagens: 377
Registrado em: 19 Set 2006 09:39
Localização: Foz do Iguaçu / Pr

Comando FOR EACH...IN...NEXT

Mensagem por deividdjs »

Boa tarde Amigos.. vejam se podem me dar uma luz ..

toda vez q preciso clonar um pedido ou gerar uma tabela temporária com alguns dados eu faço dessa maneira ..

como eu poderia automatizar a criação das variáveis para receber os valores de base de dados usando o FOR ... NEXT

Código: Selecionar todos

	   do while cc_codped == c_codped 
	
	            vc_codprod := cc_codprod   
	            vc_descr   := cc_descr     
	            vn_quant   := cn_quant     
	            vn_preco   := cn_preco     
	            vn_totitem := cn_totitem   
	            vn_totcus  := cn_totcus    
	            vc_marca   := cc_marca     
	            vc_und     := cc_und       
	            vc_decimal := cc_unddec    
	            vc_codfabr := cc_codfabr   
	            vc_local   := cc_local     
	            vn_margem  := cn_margem    
	            vn_cusmed  := cn_cusmed    
	            vn_descite := cn_descite   
	            vc_codven  := cc_codven    
	            vc_codcli  := cc_codcli    
	            vc_nomeven := cc_nomeven 
	            c_tipoven  := cc_tipoven  
	
	    select TMPCP
	    ADIC_REG()
	    replace cc_codprod  with vc_codprod,;
	            cc_descr    with vc_descr,;
	            cn_quant    with vn_quant,;
	            cn_preco    with vn_preco,;
	            cn_totitem  with vn_totitem,;
	            cn_totcus   with vn_totcus,;
	            cc_marca    with vc_marca,;
	            cc_und      with vc_und,;  
	            cc_unddec   with vc_decimal,;
	            cc_codfabr  with vc_codfabr,;
	            cc_local    with vc_local,;
	            cn_margem   with vn_margem,;
	            cn_cusmed   with vn_cusmed,;
	            cn_descite  with vn_descite,;
	            cc_codven   with vc_codven,;
	            cc_codcli   with vc_codcli,;
	            cc_nomeven  with vc_nomeven,;
	            cc_usuario  with PSW->usuario,;
	            cd_datalan  with vd_datalan,;
	            cc_time     with vc_time,;
	            cc_tipoven  with c_tipoven
	            DBCOMMIT()
	            unlock
	
	       select PDP
	       skip
	
	   enddo

A ideia seria fazer algo tipo assim :

Código: Selecionar todos


	 PDP->(ordsetfocus("PDPCX_01"),DBseek(c_codped))

	     FOR i = 1 TO FCOUNT()

  		 cFieldName  := FIELD(i)
 	         &cFieldName := PDP->&cFieldName
	      
            if cc_codped == c_codped 
        
  	            ADIC_REG()
	            REPLACE &cFieldName WITH TMP->&cFieldName  // Copia o valor da coluna da tabela original para a nova tabela
	            DBCOMMIT()
	            DBUNLOCK()
	         
	    endif   
				
		
		  NEXT
algo assim pra eu nao precisar criar as variaveis uma a uma para pegar o valor e dar um replace na tabela nova ..

Abraço!
Windows 11 + Harbour 3.2 + MINGW64 gcc 14.1.0 + Visual Lib + GTWVG + LETODBF WINDOWNS/LINUX
Voltar ao topo
Avatar do usuário
JoséQuintas
Administrador
Administrador
Mensagens: 20267
Registrado em: 26 Fev 2007 11:59
Localização: São Paulo-SP

Comando FOR EACH...IN...NEXT

Mensagem por JoséQuintas »

Acostume a usar macro somente em último caso.

Código: Selecionar todos

// leitura
aList := {}
FOR nCont = 1 TO FCount()
   AAdd( aList, FieldGet( nCont ) )
NEXT
// gravacao 
APPEND BLANK
FOR nCont = 1 TO FCount()
   FieldPut( nCont, aList[ nCont ] )
NEXT
FieldGet( nCont ) -> Obtém o campo
FieldPut( nCont, valor ) -> Salva o campo
Não esqueça no final, de salvar novo número de pedido, remover status indevidos, etc.

Tem também FieldNum( cNOMECAMPO ) se precisar obter o número a partir do nome.

Curiosidade: uso assim para aquele DLGAUTO que cria telas e salva inclusão/alteração pra qualquer DBF, assim uso direto um array pra say/get/replace
José M. C. Quintas
Harbour 3.2, mingw, gtwvg mt, fivewin 25.04, multithread, dbfcdx, MySQL, ADOClass, PDFClass, SefazClass, (hwgui mt), (hmg3), (hmg extended), (oohg), PNotepad, ASP, stored procedure, stored function, Linux (Flagship/harbour 3.2)
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"
https://github.com/JoseQuintas/
Voltar ao topo
Avatar do usuário
deividdjs
Usuário Nível 3
Usuário Nível 3
Mensagens: 377
Registrado em: 19 Set 2006 09:39
Localização: Foz do Iguaçu / Pr

Comando FOR EACH...IN...NEXT

Mensagem por deividdjs »

JoséQuintas escreveu:Acostume a usar macro somente em último caso.

Código: Selecionar todos

// leitura
aList := {}
FOR nCont = 1 TO FCount()
   AAdd( aList, FieldGet( nCont ) )
NEXT
// gravacao 
APPEND BLANK
FOR nCont = 1 TO FCount()
   FieldPut( nCont, aList[ nCont ] )
NEXT
FieldGet( nCont ) -> Obtém o campo
FieldPut( nCont, valor ) -> Salva o campo
Não esqueça no final, de salvar novo número de pedido, remover status indevidos, etc.

Tem também FieldNum( cNOMECAMPO ) se precisar obter o número a partir do nome.

Curiosidade: uso assim para aquele DLGAUTO que cria telas e salva inclusão/alteração pra qualquer DBF, assim uso direto um array pra say/get/replace


Bah Zé quando tempo eu sofri e trabalhei por falta de conhecimento kkkkk

Show essa função .. valeu irmão .. obrigado!!
Windows 11 + Harbour 3.2 + MINGW64 gcc 14.1.0 + Visual Lib + GTWVG + LETODBF WINDOWNS/LINUX
Voltar ao topo
Responder

Voltar para “[x]Harbour”