PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

Rotina pra muitos filtros

https://pctoledo.org/viewtopic.php?t=14366

Página 1 de 1

Rotina pra muitos filtros

Enviado: 24 Jul 2013 12:44
por JoséQuintas
Muitos filtros para um arquivo, sendo campos do próprio arquivo e outros relacionados.
Teria um jeito melhor de fazer isto? Talvez a tal variável hash?

Como o filtro precisaria de variáveis private, procurei reduzir pra uma única.
Um array com a estrutura, e elementos adicionais pra extras
Cada elemento contém nome, Sim/Não se filtro está ativado, campo inicial e campo final (mesmo se só usar um deles)

1) Esta função é a que gerencia os elementos, permitindo criar/salvar/recuperar informação

Código: Selecionar todos

#define FILTRO_CAMPO     1
#define FILTRO_ATIVADO   2
#define FILTRO_INI       3
#define FILTRO_FIM       4

STATIC FUNCTION osFiltroByName( cCampo, cFiltraSN, xValueIni, xValueFim )
   LOCAL nCont, acStru, xValue
   MEMVAR mFiltroOs
   
   IF cCampo == "INICIALIZA"
      acStru := dbStruct()
      FOR nCont = 1 TO Len( acStru )
         xValue := FieldGet( nCont )
         DO CASE
         CASE ValType( xValue ) == "C"
            xValue := Space( Len( xValue ) )
         CASE ValType( xValue ) == "D"
            xValue := Ctod("")
         CASE ValType( xValue ) == "N"
            xValue := 0
         ENDCASE
         Aadd( mFiltroOs, { acStru[ nCont, 1 ], "N", xValue, xValue } )
      NEXT
      Aadd( mFiltroOs, { "DTOCO", "N", Ctod(""), Ctod("") } )
      Aadd( mFiltroOs, { "DEMCLI", "N", "N", "N" } )
      Aadd( mFiltroOs, { "DEMFOR", "N", "N", "N" } )
      Aadd( mFiltroOs, { "PEDIDO", "N", "N", "N" } )
      Aadd( mFiltroOs, { "CODBAR", "N", Space( Len( jpordser->osCodBar1 ) ), Space( Len( jpordser->osCodBar1 ) ) } )
      RETURN NIL
   ENDIF
   
   FOR nCont = 1 TO Len( mFiltroOs )
      IF mFiltroOs[ nCont, FILTRO_CAMPO ] == cCampo
         IF cFiltraSN == NIL
            RETURN mFiltroOs[ nCont ]
         ENDIF
         mFiltroOs[ nCont, FILTRO_ATIVADO ] := cFiltraSN
         mFiltroOs[ nCont, FILTRO_INI ]     := xValueIni
         mFiltroOs[ nCont, FILTRO_FIM ]     := xValueFim
         EXIT
      ENDIF
   NEXT
   RETURN NIL
2. A função usada em SET FILTER TO FiltroOs(), que usa a variável acima

Código: Selecionar todos

FUNCTION FiltroOs()
   LOCAL nCont
   MEMVAR mFiltroOs, m_Prog
   IF .NOT. jpordser->osRecarga == iif( m_Prog == "PSER0010", "S", "N" )
      RETURN .f.
   ENDIF
   IF Len( mFiltroOs ) == 0
      RETURN .t.
   ENDIF
   FOR nCont = 1 TO FCount()
      IF mFiltroOs[ nCont, FILTRO_ATIVADO ] == "S"
         IF .NOT. Empty( mFiltroOs[ nCont, FILTRO_INI ] )
            IF FieldGet( nCont ) < mFiltroOs[ nCont, FILTRO_INI ]
               RETURN .f.
            ENDIF
         ENDIF
         IF .NOT. Empty( mFiltroOs[ nCont, FILTRO_FIM ] )
            IF FieldGet( nCont ) > mFiltroOs[ nCont, FILTRO_FIM ]
               RETURN .f.
            ENDIF
         ENDIF
      ENDIF
   NEXT
   IF osFiltroByName( "DTOCO" )[ FILTRO_ATIVADO ] == "S"
      SELECT jpreguso
      SEEK Pad( "JPORDSER", 8 ) + jpordser->osNumLan
      DO WHILE jpreguso->ruArquivo == Pad( "JPORDSER", 8 ) .AND. jpreguso->ruCodigo == jpordser->osNumLan .AND. .NOT. Eof()
         IF .NOT. Empty( osFiltroByName( "DTOCO" )[ FILTRO_INI ] )
            IF Left( jpreguso->ruInfInc, 4 ) < Left( Dtos( osFiltroByName( "DTOCO" )[ FILTRO_INI ] ), 4 )
               RETURN .f.
            ENDIF
         ENDIF
         IF .NOT. Empty( osFiltroByName( "DTOCO" )[ FILTRO_FIM ] )
            IF Left( jpreguso->ruInfInc, 4 ) > Left( Dtos( osFiltroByName( "DTOCO" )[ FILTRO_FIM ] ), 4 )
               RETURN .f.
            ENDIF
         ENDIF
         SKIP
      ENDDO
      SELECT jpordser
   ENDIF
   IF osFiltroByName( "DEMCLI" )[ FILTRO_ATIVADO ] == "S"
      IF osFiltroByName( "DEMCLI" )[ FILTRO_INI ] == "S"
         IF Val( jpordser->osDemFin ) == 0
            RETURN .f.
         ENDIF
      ELSE
         IF Val( jpordser->osDemFin ) != 0
            RETURN .f.
         ENDIF
      ENDIF
   ENDIF
   IF osFiltroByName( "DEMFOR" )[ FILTRO_ATIVADO ] == "S"
      IF osFiltroByName( "DEMFOR" )[ FILTRO_INI ] == "S"
         IF Val( jpordser->osDemPag ) == 0
            RETURN .f.
         ENDIF
      ELSE
         IF Val( jpordser->osDemPag ) != 0
            RETURN .f.
         ENDIF
      ENDIF
   ENDIF
   IF osFiltroByName( "PEDIDO" )[ FILTRO_ATIVADO ] == "S"
      IF osFiltroByName( "PEDIDO" )[ FILTRO_INI ] == "S"
         IF Val( jpordser->osPedido1 ) == 0 .AND. Val( jpordser->osPedido2 ) == 0 .AND. Val( jpordser->osPedido3 ) == 0
            RETURN .f.
         ENDIF
      ELSE
         IF Val( jpordser->osPedido1 ) != 0 .OR. Val( jpordser->osPedido2 ) != 0 .OR. Val( Jpordser->osPedido3 ) != 0
            RETURN .f.
         ENDIF
      ENDIF
   ENDIF
   IF osFiltroByName( "CODBAR" )[ FILTRO_ATIVADO ] == "S"
      IF jpordser->osCodBar1 == osFiltroByName( "CODBAR" )[ FILTRO_INI ]
         RETURN .t.
      ENDIF
      IF jpordser->osCodBar2 == osFiltroByName( "CODBAR" )[ FILTRO_INI ]
         RETURN .t.
      ENDIF
      IF Encontra( jpordser->osNumLan + osFiltroByName( "CODBAR" )[ FILTRO_INI ], "jpordbar", "osbar" )
         RETURN .t.
      ENDIF
      RETURN .f.
   ENDIF
   RETURN .t.
3. A digitação, não teve jeito de reduzir ainda, porque uso o nome das variáveis pra recursos adicionais, como um browse da base de dados relacionada ao campo

Código: Selecionar todos

STATIC FUNCTION TelaFiltroOs()
   LOCAL GetList := {}, nCont, mCancelaFiltro := "N"
   LOCAL mFiltroDatPrc, mosDatPrci, mosDatPrcf
   LOCAL mFiltroDatPrf, mosDatPrfi, mosDatPrff 
   LOCAL mFiltroRecarga, mosRecargai
   LOCAL mFiltroAparelho, mosAparelhoi
   LOCAL mFiltroStatus, mosStatusi, mosStatusf
   LOCAL mFiltroStatec, mosStateci, mosStaTecf
   LOCAL mFiltroStaCli, mosStaClii
   LOCAL mFiltroUrgente, mosUrgentei
   LOCAL mFiltroIntExt, mosIntExti
   LOCAL mFiltroNumDep, mosNumDepi
   LOCAL mFiltroDatEmi, mosDatEmii, mosDatEmif
   LOCAL mFiltroSosDat, mosSosDati, mosSosDatf
   LOCAL mFiltroSosHor, mosSosHori, mosSosHorf
   LOCAL mFiltroDtOco, mDtOcoi, mDtOcof
   LOCAL mFiltroDemCli, mDemCliSN
   LOCAL mFiltroDemFor, mDemForSN
   LOCAL mFiltroPedido, mPedidoSN
   LOCAL mFiltroCodBar, mCodBarI
   MEMVAR mFiltroOs
   
   mFiltroDatPrc   := osFiltroByName( "OSDATPRC"   )[ FILTRO_ATIVADO ]
   mosDatPrci      := osFiltroByName( "OSDATPRC"   )[ FILTRO_INI ]
   mosDatPrcf      := osFiltroByName( "OSDATPRC"   )[ FILTRO_FIM ]
   mFiltroDatPrf   := osFiltroByName( "OSDATPRF"   )[ FILTRO_ATIVADO ]
   mosDatPrfi      := osFiltroByName( "OSDATPRF"   )[ FILTRO_INI ]
   mosDatPrff      := osFiltroByName( "OSDATPRF"   )[ FILTRO_FIM ]
   mFiltroRecarga  := osFiltroByName( "OSRECARGA"  )[ FILTRO_ATIVADO ]
   mosRecargai     := osFiltroByName( "OSRECARGA"  )[ FILTRO_INI ]
   mFiltroAparelho := osFiltroByName( "OSAPARELHO" )[ FILTRO_ATIVADO ]
   mosAparelhoi    := osFiltroByName( "OSAPARELHO" )[ FILTRO_INI ]
   mFiltroStatus   := osFiltroByName( "OSSTATUS"   )[ FILTRO_ATIVADO ]
   mosStatusi      := osFiltroByName( "OSSTATUS"   )[ FILTRO_INI ]
   mosStatusf      := osFiltroByName( "OSSTATUS"   )[ FILTRO_FIM ]
   mFiltroStaTec   := osFiltroByName( "OSSTATEC"   )[ FILTRO_ATIVADO ]
   mosStaTeci      := osFiltroByName( "OSSTATEC"   )[ FILTRO_INI ]
   mosStaTecf      := osFiltroByName( "OSSTATEC"   )[ FILTRO_FIM ]
   mFiltroStaCli   := osFiltroByName( "OSSTACLI"   )[ FILTRO_ATIVADO ]
   mosStaClii      := osFiltroByName( "OSSTACLI"   )[ FILTRO_INI ]
   mFiltroNumDep   := osFiltroByName( "OSNUMDEP"   )[ FILTRO_ATIVADO ]
   mosNumDepi      := osFiltroByName( "OSNUMDEP"   )[ FILTRO_INI ]
   mFiltroUrgente  := osFiltroByName( "OSURGENTE"  )[ FILTRO_ATIVADO ]
   mosUrgentei     := osFiltroByName( "OSURGENTE"  )[ FILTRO_INI ]
   mFiltroIntExt   := osFiltroByName( "OSINTEXT"   )[ FILTRO_ATIVADO ]
   mosIntExti      := osFiltroByName( "OSINTEXT"   )[ FILTRO_INI ]
   mFiltroDatEmi   := osFiltroByName( "OSDATEMI"   )[ FILTRO_ATIVADO ]
   mosDatEmii      := osFiltroByName( "OSDATEMI"   )[ FILTRO_INI ]
   mosDatEmif      := osFiltroByName( "OSDATEMI"   )[ FILTRO_FIM ]
   mFiltroSosDat   := osFiltroByName( "OSSOSDAT"   )[ FILTRO_ATIVADO ]
   mosSosDati      := osFiltroByName( "OSSOSDAT"   )[ FILTRO_INI ]
   mosSosDatf      := osFiltroByName( "OSSOSDAT"   )[ FILTRO_FIM ]
   mFiltroSosHor   := osFiltroByName( "OSSOSHOR"   )[ FILTRO_ATIVADO ]
   mosSosHori      := osFiltroByName( "OSSOSHOR"   )[ FILTRO_INI ]
   mosSosHorf      := osFiltroByName( "OSSOSHOR"   )[ FILTRO_FIM ]
   mFiltroDtOco    := osFiltroByName( "DTOCO"      )[ FILTRO_ATIVADO ]
   mDtOcoi         := osFiltroByName( "DTOCO"      )[ FILTRO_INI ]
   mDtOcof         := osFiltroByName( "DTOCO"      )[ FILTRO_FIM ]
   mFiltroDemCli   := osFiltroByName( "DEMCLI"     )[ FILTRO_ATIVADO ]
   mDemCliSN       := osFiltroByName( "DEMCLI"     )[ FILTRO_ATIVADO ]
   mFiltroDemFor   := osFiltroByName( "DEMFOR"     )[ FILTRO_ATIVADO ]
   mDemForSN       := osFiltroByName( "DEMFOR"     )[ FILTRO_INI ]
   mFiltroPedido   := osFiltroByName( "PEDIDO"     )[ FILTRO_ATIVADO ]
   mPedidoSN       := osFiltroByName( "PEDIDO"     )[ FILTRO_INI ]
   mFiltroCodBar   := osFiltroByName( "CODBAR"     )[ FILTRO_ATIVADO ]
   mCodBarI        := osFiltroByName( "CODBAR"     )[ FILTRO_INI ]
   
   WOpen( 7, 5, 30, 90, "Filtro de OS" )

   @ 9, 7 SAY "Elimina filtro" GET mCancelaFiltro PICTURE "!A" VALID mCancelaFiltro $ "SN"
   
   @ Row()+2, 7 SAY "Previsao Cliente de/ate:" GET mFiltroDatPrc PICTURE "!A" VALID mFiltroDatPrc $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatPrci WHEN mFiltroDatPrc == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatPrcf WHEN mFiltroDatPrc == "S" .AND. mCancelaFiltro != "S"

   @ Row()+1, 7 SAY "Previsao Fornecedor de/ate:" GET mFiltroDatPrf PICTURE "!A" VALID mFiltroDatPrf $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatPrfi WHEN mFiltroDatPrf == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatPrff WHEN mFiltroDatPrf == "S" .AND. mCancelaFiltro != "S"

   @ Row()+1, 7 SAY "Recarga:" GET mFiltroRecarga PICTURE "!A" VALID mFiltroRecarga $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 SAY "Recarga (S/N):" GET mosRecargai PICTURE "!A" VALID mosRecargai $ "SN" WHEN mFiltroRecarga == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Aparelho:" GET mFiltroAparelho PICTURE "!A" VALID mFiltroAparelho $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosAparelhoi PICTURE "@!" VALID Valida():Auxiliar( mosAparelhoi, 97 ) WHEN mFiltroAparelho == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Status Tecnico de/ate:" GET mFiltroStaTec PICTURE "!A" VALID mFiltroStaTec $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosStaTeci PICTURE "@K 999999" WHEN mFiltroStaTec == "S" .AND. mCancelaFiltro != "S" VALID AuxOrdTecClass():Valida( @mosStaTeci )
   @ Row(), Col()+2 GET mosStaTecf PICTURE "@K 999999" WHEN mFiltroStaTec == "S" .AND. mCancelaFiltro != "S" VALID AuxOrdTecClass():Valida( @mosStaTecf )
   
   @ Row()+1, 7 SAY "Status de/ate:" GET mFiltroStatus PICTURE "!A" VALID mFiltroStatus $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosStatusi PICTURE "@K 999999" WHEN mFiltroStatus == "S" .AND. mCancelaFiltro != "S" VALID AuxOrdStaClass():Valida( @mosStatusi )
   @ Row(), Col()+2 GET mosStatusf PICTURE "@K 999999" WHEN mFiltroStatus == "S" .AND. mCancelaFiltro != "S" VALID AuxOrdStaClass():Valida( @mosStatusf )
   
   @ Row()+1, 7 SAY "Status Cliente:" GET mFiltroStaCli PICTURE "!A" VALID mFiltroStaCli $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosStaClii PICTURE "@K 999999" WHEN mFiltroStaCli == "S" .AND. mCancelaFiltro != "S" VALID AuxOrdCliClass():Valida( @mosStaClii )
   
   @ Row()+1, 7 SAY "Localizacao:" GET mFiltroNumDep PICTURE "!A" VALID mFiltroNumDep $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosNumDepi PICTURE "9" WHEN mFiltroNumDep == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Urgente:" GET mFiltroUrgente PICTURE "!A" VALID mFiltroUrgente $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosUrgentei PICTURE "!A" WHEN mFiltroUrgente == "S" .AND. mCancelaFiltro != "S"
  
   @ Row()+1, 7 SAY "Int/Ext:" GET mFiltroIntExt PICTURE "!A" VALID mFiltroIntExt $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosIntExti PICTURE "!A" WHEN mFiltroIntExt == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Emissao de/ate:" GET mFiltroDatEmi PICTURE "!A" VALID mFiltroDatEmi $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatEmii WHEN mFiltroDatEmi == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosDatEmif WHEN mFiltroDatEmi == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Lembrete Data de/ate:" GET mFiltroSosDat PICTURE "!A" VALID mFiltroSosDat $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosSosDati WHEN mFiltroSosDat == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosSosDatf WHEN mFiltroSosDat == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Lembrete Hora de/ate:" GET mFiltroSosHor PICTURE "!A" VALID mFiltroSosHor $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosSosHori WHEN mFiltroSosHor == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mosSosHorf WHEN mFiltroSosHor == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Ocorrencias de/ate:" GET mFiltroDtOco PICTURE "!A" VALID mFiltroDtOco $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mDtOcoi WHEN mFiltroDtOco == "S" .AND. mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mDtOcof WHEN mFiltroDtOco == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Dem.Cliente:" GET mFiltroDemCli PICTURE "!A" VALID mFiltroDemCli $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 SAY "Com Demonstrativo (S/N):" GET mDemCliSN PICTURE "!A" VALID mDemCliSN $ "SN" WHEN mFiltroDemCli == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Dem.Fornec:" GET mFiltroDemFor PICTURE "!A" VALID mFiltroDemFor $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 SAY "Com Demonstrativo (S/N):" GET mDemForSN PICTURE "!A" VALID mDemForSN $ "SN" WHEN mFiltroDemFor == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Pedido:" GET mFiltroPedido PICTURE "!A" VALID mFiltroPedido $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 SAY "Com Pedido (S/N):" GET mPedidoSN PICTURE "!A" VALID mPedidoSN $ "SN" WHEN mFiltroPedido == "S" .AND. mCancelaFiltro != "S"
   
   @ Row()+1, 7 SAY "Cod.Barras:" GET mFiltroCodBar PICTURE "!A" VALID mFiltroCodBar $ "SN" WHEN mCancelaFiltro != "S"
   @ Row(), Col()+2 GET mCodBarI PICTURE "@!" WHEN mFiltroCodBar == "S" .AND. mCancelaFiltro != "S"
   
   Mensagem( "Selecione filtros, ESC mantem filtro existente" )
   READ
   Mensagem()

   IF LastKey() != K_ESC
      IF mCancelaFiltro == "S"
         FOR nCont = 1 TO Len( mFiltroOs )
            mFiltroOs[ nCont, FILTRO_ATIVADO ] := "N"
         NEXT
      ELSE
         osFiltroByName( "OSDATPRC",   mFiltroDatPrc,   mosDatPrci,   mosDatPrcf )
         osFiltroByName( "OSDATPRF",   mFiltroDatPrf,   mosDatPrfi,   mosDatPrff )
         osFiltroByName( "OSRECARGA",  mFiltroRecarga,  mosRecargai,  mosRecargai )
         osFiltroByName( "OSAPARELHO", mFiltroAparelho, mosAparelhoi, mosAparelhoi )
         osFiltroByName( "OSSTATUS",   mFiltroStatus,   mosStatusi,   mosStatusf )
         osFiltroByName( "OSSTATEC",   mFiltroStaTec,   mosStaTeci,   mosStaTecf )
         osFiltroByName( "OSSTACLI",   mFiltroStaCli,   mosStaClii,   mosStaClii )
         osFiltroByName( "OSNUMDEP",   mFiltroNumDep,   mosNumDepi,   mosNumDepi )
         osFiltroByName( "OSURGENTE",  mFiltroUrgente,  mosUrgentei,  mosUrgentei )
         osFiltroByName( "OSINTEXT",   mFiltroIntExt,   mosIntExti,   mosIntExti )
         osFiltroByName( "OSDATEMI",   mFiltroDatEmi,   mosDatEmii,   mosDatEmif )
         osFiltroByName( "OSSOSDAT",   mFiltroSosDat,   mosSosDati,   mosSosDatf )
         osFiltroByName( "OSSOSHOR",   mFiltroSosHor,   mosSosHori,   mosSosHorf )
         osFiltroByName( "DTOCO",      mFiltroDtOco,    mDtOcoi,      mDtOcof )
         osFiltroByName( "DEMCLI",     mFiltroDemCli,   mDemCliSN,    mDemCliSN )
         osFiltroByName( "DEMFOR",     mFiltroDemFor,   mDemForSN,    mDemForSN )
         osFiltroByName( "PEDIDO",     mFiltroPedido,   mPedidoSN,    mPedidoSN )
         osFiltroByName( "CODBAR",     mFiltroCodBar,   mCodBarI,     mCodBarI  )
      ENDIF
   ENDIF

   SET FILTER TO FiltroOs()
   GOTO TOP
   WClose()
   RETURN NIL

Agora que percebi alguns erros no filtroOs(), de retornar em área errada. Vou corrigir acrescentando SELECT (nSelect) mas não vou postar novamente.
Só queria saber se tem como simplificar, mantendo os nomes de varíaveis nos GETS, ou de alguma forma que eu consiga ter estes nomes com identificação exclusiva (saber exatamente quem é quem num ReadVar() )
Ou usar as variáveis hash, ou algum jeito diferente pra simplificar/agilizar o resto.

Rotina pra muitos filtros

Enviado: 03 Ago 2013 00:11
por JoséQuintas
Tava um pouco inspirado hoje, mas não muito....

É só um protótipo de filtro, no estilo do que tem no MediaMonkey.

Primeiro o usuário escolhe o campo.
Depois escolhe o tipo de comparação: igual, diferente, etc.
Por fim, digita o(s) valor(es) para comparação.

O array de controle contém todos os campos.
Cada elemento tem: nome do campo, tipo de filtro, valor inicial, valor final.
Pra testar num arquivo, basta alterar o nome do DBF.
Como é protótipo, só faz contagem de registros. Poderia ter um browse também.

Código: Selecionar todos

#define FILTRO_CAMPO     1
#define FILTRO_TIPO      2
#define FILTRO_INI       3
#define FILTRO_FIM       4

#define COMPARE_SEM_FILTRO            1
#define COMPARE_IGUAL                 2
#define COMPARE_MAIOR_OU_IGUAL        3
#define COMPARE_MENOR_OU_IGUAL        4
#define COMPARE_MAIOR                 5
#define COMPARE_MENOR                 6 
#define COMPARE_DIFERENTE             7
#define COMPARE_DE_ATE                8 
#define COMPARE_TEXTO_CONTEM          9 
#define COMPARE_TEXTO_NAO_CONTEM     10
#define COMPARE_TEXTO_COMECA_COM     11

PROCEDURE Main
   LOCAL acStru, nCont, acFiltros := {}, xValue, acCampos := {}, nOpcCampo, nOpcCompare, acCompare := {}, nQtdRec, cFiltro, lSoma
   
   SET DATE BRITISH
   SET CENTURY ON

   acCompare := { "- Sem Filtro", "= Igual", ">= Maior ou Igual", "<= Menor ou igual", "> Maior", "< Menor", "!= Diferente", "x-y Intervalo", "*x* Texto Contem", "!*x*Texto Nao Contem", "x* Texto Comeca Com" }
   USE D:\JPA\CORDEIRO\JPCADAS
   acStru := dbStruct()
   FOR nCont = 1 TO Len( acStru )
      xValue := EmptyValue( FieldGet( nCont ) )
      Aadd( acFiltros, { FieldName( nCont ), COMPARE_SEM_FILTRO, xValue, xValue } )
      Aadd( acCampos, FieldName( nCont ) )
   NEXT
   DO WHILE .t.
      GOTO TOP
      nQtdRec := 0
      DO WHILE .NOT. Eof()
         lSoma := .t.
         FOR nCont = 1 TO Len( acFiltros )
            DO CASE
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_SEM_FILTRO
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_IGUAL
               lSoma := lSoma .AND. ( FieldGet( nCont ) == acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_MAIOR_OU_IGUAL
               lSoma := lSoma .AND. ( FieldGet( nCont ) >= acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_MENOR_OU_IGUAL
               lSoma := lSoma .AND. ( FieldGet( nCont ) <= acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_MAIOR
               lSoma := lSoma .AND. ( FieldGet( nCont ) > acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_MENOR
               lSoma := lSoma .AND. ( FieldGet( nCont ) < acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_DIFERENTE
               lSoma := lSoma .AND. ( FieldGet( nCont ) != acFiltros[ nCont, FILTRO_INI ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_DE_ATE
               lSoma := lSoma .AND. ( FieldGet( nCont ) >= acFiltros[ nCont, FILTRO_INI ] .AND. FieldGet( nCont ) <= acFiltros[ nCont, FILTRO_FIM ] )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_TEXTO_CONTEM
               lSoma := lSoma .AND. ( Trim( acFiltros[ nCont, FILTRO_INI ] ) $ FieldGet( nCont ) )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_TEXTO_NAO_CONTEM
               lSoma := lSoma .AND. ( .NOT. Trim( acFiltros[ nCont, FILTRO_INI ] ) $ FieldGet( nCont ) )
            CASE acFiltros[ nCont, FILTRO_TIPO ] == COMPARE_TEXTO_COMECA_COM
               lSoma := lSoma .AND. ( Substr( FieldGet( nCont ), 1, Len( Trim( acFiltros[ nCont, FILTRO_INI ] ) ) ) == acFiltros[ nCont, FILTRO_INI ] )
            ENDCASE
         NEXT
         IF lSoma
            nQtdRec += 1
         ENDIF
         SKIP
      ENDDO
      CLS
      @ 2, 0 SAY "Qtd.Registros no filtro " + Str( nQtdRec )
      nOpcCampo := aChoice( 5,0,24,79,acCampos )
      IF LastKey() == 27
          EXIT
      ENDIF
      CLS
      nOpcCompare := aChoice( 5,0,24,79,acCompare )
      IF LastKey() == 27
          EXIT
      ENDIF
      DO CASE
      CASE nOpcCompare == COMPARE_SEM_FILTRO 
         acFiltros[ nOpcCampo, FILTRO_TIPO ] := nOpcCompare 
      CASE nOpcCompare == COMPARE_DE_ATE
         acFiltros[ nOpcCampo, FILTRO_TIPO ] := nOpcCompare
         @ 12, 20 GET acFiltros[ nOpcCampo, FILTRO_INI ]
         @ 13, 20 GET acFiltros[ nOpcCampo, FILTRO_FIM ]
         READ
      CASE nOpcCompare == COMPARE_TEXTO_CONTEM .OR. nOpcCompare == COMPARE_TEXTO_NAO_CONTEM .OR. nOpcCompare == COMPARE_TEXTO_COMECA_COM
         IF ValType( acFiltros[ nOpcCampo, FILTRO_INI ] ) != "C"
            ? "Filtro invalido"
         ELSE
            acFiltros[ nOpcCampo, FILTRO_TIPO ] := nOpcCompare
            @ 12, 20 GET acFiltros[ nOpcCampo, FILTRO_INI ]
            READ
         ENDIF
      OTHERWISE
         acFiltros[ nOpcCampo, FILTRO_TIPO ] := nOpcCompare
         @ 12, 20 GET acFiltros[ nOpcCampo, FILTRO_INI ]
         READ
      ENDCASE
   ENDDO
   CLOSE DATABASES
   CLS
   RETURN

STATIC FUNCTION EmptyValue( xValue )
DO CASE
CASE ValType( xValue ) == "N"
   xValue := 0
CASE ValType( xValue ) == "D"
   xValue := Ctod("")
OTHERWISE
   xValue := Space( Len( xValue ) )
ENDCASE
RETURN xValue

Rotina pra muitos filtros

Enviado: 21 Ago 2013 23:47
por JoséQuintas
Ainda em protótipo, mas funcionando.
Basta alterar o nome do DBF que está sendo aberto no início.
Compilar com hbmk2 test -lhbct

O estranho é que alterei pra Achoice() e hbct e agora não dá pra ver os GETs ou Alert(), ficaram invisíveis mas funcionando.
No meu uso normal ainda funciona. (sem o achoice e minhas próprias wopen(), wclose() )

Ainda falta pensar num jeito de filtar por arquivos relacionados, por exemplo no financeiro relacionado a um cadastro de clientes, ou vice-versa.

Código: Selecionar todos

#include "hbclass.ch"
#include "inkey.ch"

PROCEDURE Main
   LOCAL nQtdRec
   MEMVAR oFilter
   PRIVATE oFilter

   SetColor( "W/B,N/W,,,W/B" )
   CLS   
   USE d:\jpa\cordeiro\jpcadas
   
   oFilter := FilterClass():New()
   DO WHILE .t.
      IF .NOT. oFilter:ChooseFilter()
         EXIT
      ENDIF
      SET FILTER TO oFilter:Filter()
      COUNT TO nQtdRec
      @ 1, 0 SAY "Records in Filter:" + Str( nQtdRec )
      oFilter:Show( MaxRow()-2, 0, MaxRow(), MaxCol() )
      Browse( 2, 0, MaxRow()-4, MaxCol() )
   ENDDO
   CLOSE DATABASES
   RETURN
*---------------- 

#define FILTER_FIELD     1
#define FILTER_TYPE      2
#define FILTER_INI       3
#define FILTER_END       4

#define FILTER_NO_FILTER            1   //
#define FILTER_EQUAL                2   // =
#define FILTER_GREATHER_OR_EQUAL    3   // >=
#define FILTER_LESS_OR_EQUAL        4   // <=
#define FILTER_GREATHER             5   // >
#define FILTER_LESS                 6   // <
#define FILTER_NOT_EQUAL            7   // !=
#define FILTER_FROM_TO              8   // >= ini .AND. <= end
#define FILTER_HAS_TEXT             9   // text $ field
#define FILTER_NOT_HAS_TEXT        10   // .not. text $ field
#define FILTER_BEGIN_WITH_TEXT     11   // field = text*

CREATE CLASS FilterClass
   DATA   acFilterConfig    INIT {}
   METHOD Init()
   METHOD Filter()                                // filter result
   METHOD FilterAsString()                        // an string with filter to be displayed
   METHOD FilterOptionsAsArray( lIncludeAll )     // an array to use as options to select
   METHOD FilterOptions()                         // an array with filter types
   METHOD Show( nRowi, nColi, nRowf, nColf )      // diplay filter string
   METHOD ChooseFilter()                          // user select filter options
   END CLASS

METHOD Init() CLASS FilterClass
   LOCAL acStru, nCont, xValue

   acStru := dbStruct()
   FOR nCont = 1 TO Len( acStru )
      xValue := EmptyValue( FieldGet( nCont ) )
      Aadd( ::acFilterConfig, { FieldName( nCont ), FILTER_NO_FILTER, xValue, xValue } )
   NEXT
   RETURN NIL

METHOD Filter() Class FilterClass
   LOCAL xValue := .t., nCont
   
   FOR nCont = 1 TO Len( ::acFilterConfig )
      DO CASE
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_NO_FILTER
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_EQUAL
         xValue := xValue .AND. ( FieldGet( nCont ) == ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_GREATHER_OR_EQUAL
         xValue := xValue .AND. ( FieldGet( nCont ) >= ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_LESS_OR_EQUAL
         xValue := xValue .AND. ( FieldGet( nCont ) <= ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_GREATHER
         xValue := xValue .AND. ( FieldGet( nCont ) > ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_LESS
         xValue := xValue .AND. ( FieldGet( nCont ) < ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_NOT_EQUAL
        xValue := xValue .AND. ( FieldGet( nCont ) != ::acFilterConfig[ nCont, FILTER_INI ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_FROM_TO
        xValue := xValue .AND. ( FieldGet( nCont ) >= ::acFilterConfig[ nCont, FILTER_INI ] .AND. FieldGet( nCont ) <= ::acFilterConfig[ nCont, FILTER_END ] )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_HAS_TEXT
         xValue := xValue .AND. ( Trim( ::acFilterConfig[ nCont, FILTER_INI ] ) $ FieldGet( nCont ) )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_NOT_HAS_TEXT
         xValue := xValue .AND. ( .NOT. Trim( ::acFilterConfig[ nCont, FILTER_INI ] ) $ FieldGet( nCont ) )
      CASE ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_BEGIN_WITH_TEXT
         xValue := xValue .AND. ( Substr( FieldGet( nCont ), 1, Len( Trim( ::acFilterConfig[ nCont, FILTER_INI ] ) ) ) == Trim( ::acFilterConfig[ nCont, FILTER_INI ] ) )
      ENDCASE
   NEXT
   RETURN xValue

METHOD FilterAsString() CLASS FilterClass
   LOCAL xValue, nCont

   xValue := ""
   FOR nCont = 1 TO Len( ::acFilterConfig )
      IF ::acFilterConfig[ nCont, FILTER_TYPE ] != FILTER_NO_FILTER
         xValue += ::acFilterConfig[ nCont, FILTER_FIELD ] + " "
         xValue += ::FilterOptions()[ ::acFilterConfig[ nCont, FILTER_TYPE ] ] + " "
         IF ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_FROM_TO
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_INI ], "" ) ) + " to "
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_END ], "" ) )
         ELSE
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_INI ], "" ) )
         ENDIF
         xValue += ", "
      ENDIF
   NEXT
   RETURN xValue

METHOD FilterOptionsAsArray( lIncludeAll ) CLASS FilterClass
   LOCAL xValue, nCont, acTxtFiltros := {}
   
   lIncludeAll := iif( lIncludeAll == NIL, .t., lIncludeAll )
   FOR nCont = 1 TO Len( ::acFilterConfig )
      xValue := ::acFilterConfig[ nCont, FILTER_FIELD ] + " "
      IF ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_NO_FILTER
         xValue += " No Filter "
      ELSE
         xValue += ::FilterOptions()[ ::acFilterConfig[ nCont, FILTER_TYPE ] ] + " "
         IF ::acFilterConfig[ nCont, FILTER_TYPE ] == FILTER_FROM_TO
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_INI ], "" ) ) + " ate "
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_END ], "" ) )
         ELSE
            xValue += Trim( Transform( ::acFilterConfig[ nCont, FILTER_INI ], "" ) )
         ENDIF
      ENDIF
      IF ::acFilterConfig[ nCont, FILTER_TYPE ] != FILTER_NO_FILTER .OR. lIncludeAll
         Aadd( acTxtFiltros, xValue )
      ENDIF
   NEXT
   RETURN acTxtFiltros
   
METHOD FilterOptions() CLASS FilterClass
   LOCAL xValue := { "No Filter", "equal", "Greather or Equal", "Less or Equal", "Greather", "Less", "Not Equal", "From/To", "Have Text", "Haven't Text", "Begin With" }
   RETURN xValue

METHOD Show( nRowi, nColi, nRowf, nColf ) CLASS FilterClass
   LOCAL cText, nLen, nCont

   nLen := nColf - nColi + 1
   cText := ::FilterAsString()
   FOR nCont = nRowi TO nRowf
      @ nCont, nColi SAY Substr( cText, ( nCont - nRowi ) * nLen + 1, nLen )
   NEXT
   RETURN NIL

METHOD ChooseFilter() CLASS FilterClass
   LOCAL nOpcFilterField := 1, nFilterType, GetList := {}, nCont, acTxtActive, nOpcActive := 1

   wOpen( 5, 0, 20, 80, "Filter" )
   DO WHILE .t.
      acTxtActive := ::FilterOptionsAsArray( .f. )
      aSize( acTxtActive, Len( acTxtActive ) + 3 )
      FOR nCont = 1 TO 3
         AIns( acTxtActive, 1 )
      NEXT
      acTxtActive[ 1 ] := "Finish Filter"
      acTxtActive[ 2 ] := "Change Filter"
      acTxtActive[ 3 ] := "Reset"
      nOpcActive := Min( nOpcActive, Len( acTxtActive ) )
      Scroll( 7, 1, 19, 79, 0 )
      Achoice( 7, 1, 19, 79, acTxtActive, .t. ,,@nOpcActive )
      IF LastKey() == K_ESC .OR. nOpcActive == 1
         EXIT
      ENDIF
      IF nOpcActive == 3
         FOR nCont = 1 TO Len( ::acFilterConfig )
            ::acFilterConfig[ nCont, FILTER_TYPE ] := FILTER_NO_FILTER
         NEXT
         LOOP
      ENDIF
      wOpen( 5, 0, 20, 80, "Field To Filter" )
      DO WHILE .t.
         Achoice( 7, 1, 19, 79, ::FilterOptionsAsArray(), .t.,,@nOpcFilterField )
         IF LastKey() == K_ESC
            EXIT
         ENDIF
         wOpen( 6, 10, 20, 60, "Filter Type" )
         DO WHILE .t.
            Achoice( 8, 11, 19, 59, ::FilterOptions, .t.,,@nFilterType )
            IF LastKey() == K_ESC
               EXIT
            ENDIF
            DO CASE
            CASE nFilterType == FILTER_NO_FILTER 
               ::acFilterConfig[ nOpcFilterField, FILTER_TYPE ] := nFilterType
            CASE nFilterType == FILTER_FROM_TO
               ::acFilterConfig[ nOpcFilterField, FILTER_TYPE ] := nFilterType
               wOpen( 10, 20, 16, 80, "From/To" )
               SetColor( "W/B,N/W,,,W/B" )
               IF ValType( ::acFilterConfig[ nOpcFilterField, FILTER_INI ] ) == "C"
                  IF Len( ::acFilterConfig[ nOpcFilterField, FILTER_INI ] ) > 48
                     @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ] PICTURE "@!S 48"
                     @ 14, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_END ] PICTURE "@!S 48"
                  ELSE
                     @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ] PICTURE "@!"
                     @ 14, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_END ] PICTURE "@!"
                  ENDIF
               ELSE
                  @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ]
                  @ 14, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_END ]
               ENDIF
               READ
               wClose()
            CASE nFilterType == FILTER_HAS_TEXT .OR. nFilterType == FILTER_NOT_HAS_TEXT .OR. nFilterType == FILTER_BEGIN_WITH_TEXT
               IF ValType( ::acFilterConfig[ nOpcFilterField, FILTER_INI ] ) != "C"
                  Alert( "Valid only for String" )
               ELSE
                  wOpen( 10, 20, 15, 80, "Value To Compare" )
                  ::acFilterConfig[ nOpcFilterField, FILTER_TYPE ] := nFilterType
                  SetColor( "W/B,N/W,,,W/B" )
                  @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ] PICTURE "@!"
                  READ
                  wClose()
               ENDIF
            OTHERWISE
               ::acFilterConfig[ nOpcFilterField, FILTER_TYPE ] := nFilterType
               wOpen( 10, 20, 15, 80, "Value To Compare" )
               SetColor( "W/B,N/W,,,W/B" )
               IF ValType( ::acFilterConfig[ nOpcFilterField, FILTER_INI ] ) == "C"
                  @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ] PICTURE "@!"
               ELSE
                  @ 12, 22 GET ::acFilterConfig[ nOpcFilterField, FILTER_INI ] 
               ENDIF
               READ
               wClose()
            ENDCASE
            EXIT
         ENDDO
         wClose()
      ENDDO
      wClose()
   ENDDO
   wClose()
   RETURN LastKey() != K_ESC

FUNCTION EmptyValue( xValue )
   DO CASE
   CASE ValType( xValue ) == "N"
      xValue := 0
   CASE ValType( xValue ) == "D"
      xValue := Ctod("")
   CASE ValType( xValue ) == "C"
      xValue := Space( Len( xValue ) )
   ENDCASE
   RETURN xValue

Rotina pra muitos filtros

Enviado: 01 Set 2013 13:03
por yugi386
Saudações a todos,

Sistema de filtragem para arquivos DBF/CDX [Rotina para vários filtros]

Código: Selecionar todos

/**
   UMA ESTRATÉGIA PARA A FILTRAGEM DE DADOS EM BASES DBF
   01 de setembro de 2013 - Yugi
*/

#include <hmg.ch>
#define QUEBRA CHR(13) + CHR(10)

Function Main
      REQUEST DBFCDX
      rddSetDefault( "DBFCDX" )
      SET DATE FRENCH
      SET CENTURY ON

      PRIVATE xInfo:=.F.

        Load Window Main
        Main.Center
        Main.Activate

Return

// --------------------------------------------------------------------------- 
// Inicia o sistema desabilitando componentes
FUNCTION iniciar()
   Main.carregar.enabled := .T.
   Main.adicionar.enabled := .F.
   Main.retirar.enabled := .F.
   Main.limpar.enabled := .F.
   Main.filtrar1.enabled := .F.
   Main.filtro.enabled := .F.
   Main.limite.enabled := .F.
   Main.campos.enabled := .F.
   Main.CAMPOS.deleteAllItems
   Main.LOGICA.deleteAllItems
   Main.logica.enabled := .F.
   Main.lista.deleteallitems
   
   IF (xInfo==.F.)
      MSGINFO("ATENÇÃO!!! " + QUEBRA + "Digite o caminho completo do seu arquivo DBF," + QUEBRA + ;
              "Ou deixe o campo tabela em branco e o sistema vai gerar um arquivo de teste pra você!!!", "AVISO")
      xInfo := .T.
   ENDIF
   
RETURN
// --------------------------------------------------------------------------- 
// Carrega o arquivo DBF
FUNCTION CARREGAR()
   iniciar()
   if empty(alltrim(Main.tabela.value))
      CRIARDBF()
      Main.tabela.value:="DBFMAX.DBF"
   ELSE 
      if file(Main.tabela.value) 
         INDEXAR()
      else
         Msgstop("Arquivo não encontrado!!!","ERRO")
         RETURN
      endif      
   endif
   
   Main.adicionar.enabled := .T.
   Main.retirar.enabled := .T.
   Main.limpar.enabled := .T.
   Main.filtrar1.enabled := .T.
   Main.filtro.enabled := .T.
   Main.limite.enabled := .T.
   Main.campos.enabled := .T.
   Main.logica.enabled := .T.
   
   MUDARCAMPO()
   preencherGrid()
   
RETURN
// ----------------------------------------------------------------------------
FUNCTION INDEXAR()
   LOCAL tabela := alltrim(Main.tabela.value), campos, ct, nCampo, indiceCDX
   
   indiceCDX := tabela
   ct := HB_UTF8RAT("\",indiceCDX)
   arqIndex := strtran(UPPER(HB_USUBSTR(indiceCDX,ct+1)),".DBF","")
   indiceCDX := HB_USUBSTR(indiceCDX,1,ct) + arqIndex
   
   opc := MsgYesNo("ATENÇÃO!"+QUEBRA+;
            "Para utilizar esta rotina será necessário indexar seu arquivo DBF!" + QUEBRA + QUEBRA+;
            "Deseja ignorar a indexação?","ATENÇÃO")
   
   arq := arqIndex+".cdx"
   if file(arq) .and. opc == .F.  
      delete file &arq
   endif
   
   Tinicio := seconds()
   use &tabela
   set order to 0
   campos := Dbstruct()
   
   for ct:= 1 to len(campos)
      nCampo := campos[ct][1]
      if (Upper(campos[ct][2]) != "M" .AND. opc==.F.) 
         index on &nCampo tag &nCampo to &indiceCDX
         commit
         Main.statusbar.item(1) := "Indexando: " + campos[ct][1]
         Main.show()
      endif
       Main.campos.item(ct):= nCampo + "["+campos[ct][2]+"]"
   next   
   
     Main.campos.value := 1
     
   set index to &indicecdx
   dbgotop()
   commit
   close all
   
   Main.statusbar.item(1) := ""
   tfim = str(int(seconds() - tinicio))
   Msginfo("Fim da Indexação!"+QUEBRA+;
            "Agora você pode começar a utilizar o sistema de filtragem!","Sucesso")
   
RETURN
// --------------------------------------------------------------------------
/**
Cria um DBF de exemplo:
*/
FUNCTION criarDBF()
   local lista_campos:=""

      MSGINFO("AGUARDE A GERAÇÃO DO ARQUIVO DE TESTE COM 1.000.000 DE REGISTROS","AVISO")   
      
      tempo := seconds()
      
            delete file DBFMAX.DBF 
            DELETE FILE "DBFMAX.CDX"
            DELETE FILE "DBFMAX.FPT"
        
        aDbf := {}
        AADD(aDbf, { "C01", "C", 50  , 0 })
        AADD(aDbf, { "C02", "D", 10  , 0 })
        AADD(aDbf, { "C03", "L", 1   , 0 })
        AADD(aDbf, { "C04", "N", 10  , 2 })
        AADD(aDbf, { "C05", "M", 1024, 0 })
        
        AADD(aDbf, { "C06", "C", 50  , 0 })
        AADD(aDbf, { "C07", "D", 10  , 0 })
        AADD(aDbf, { "C08", "L", 1   , 0 })
        AADD(aDbf, { "C09", "N", 10  , 2 })
        AADD(aDbf, { "C10", "M", 1024, 0 })
        
        AADD(aDbf, { "C11", "C", 50  , 0 })
        AADD(aDbf, { "C12", "D", 10  , 0 })
        AADD(aDbf, { "C13", "L", 1   , 0 })
        AADD(aDbf, { "C14", "N", 10  , 2 })
        AADD(aDbf, { "C15", "M", 1024, 0 })
        
        AADD(aDbf, { "C16", "C", 50  , 0 })
        AADD(aDbf, { "C17", "D", 10  , 0 })
        AADD(aDbf, { "C18", "L", 1   , 0 })
        AADD(aDbf, { "C19", "N", 10  , 2 })
        AADD(aDbf, { "C20", "M", 1024, 0 })
        
        DBF := "DBFMAX"
        DBCREATE(DBF, ADBF)

    USE DBFMAX
    
   // Povoando o banco de dados:     
   lim := 1000000
   numVerifica := 0 
   
   for ct:= 1 to lim
      append blank
      replace C01 with Fpalavra(51,seconds()*100+(ct*2))
      replace C02 with iif(campoData() + (((CT%1000000)**2)%3650) > CTOD("31/12/2020"),campodata(),campoData() + (CT%3650)+1)
      replace C03 with iif(lrandom(2,seconds()*100+ct)==1, .T. , .F.)
      replace C04 with (FnumRand(1000000,seconds()*100+(ct*2.4)))/100  // campoNumerico()
      replace C05 with Fpalavra(1025,seconds()*100+(ct*6))
      
      replace C06 with Fpalavra(51,seconds()*100+(ct*3))
      replace C07 with iif(campoData() + (((CT%1000000)**2.1)%1997) > CTOD("31/12/2020"),campodata(),campoData() + (CT%1997)+2)
      replace C08 with iif(lrandom(2,seconds()*90+ct)==1, .T. , .F.)
      replace C09 with (FnumRand(1000000,seconds()*100+(ct*4.4)))/100  // campoNumerico()
      replace C10 with Fpalavra(1025,seconds()*100+(ct*7))
      
      replace C11 with Fpalavra(51,seconds()*100+(ct*4))
      replace C12 with iif(campoData() + (((CT%1000000)**2.2)%1650) > CTOD("31/12/2020"),campodata(),campoData() + (CT%1650)+3)
      replace C13 with iif(lrandom(2,seconds()*80+ct)==1, .T. , .F.)
      replace C14 with (FnumRand(1000000,seconds()*100+(ct*6.4)))/100  // campoNumerico()
      replace C15 with Fpalavra(1025,seconds()*100+(ct*8))
      
      replace C16 with Fpalavra(51,seconds()*100+(ct*5))
      replace C17 with iif(campoData() + (((CT%1000000)**2.3)%4650) > CTOD("31/12/2020"),campodata(),campoData() + (CT%4650)+4)
      replace C18 with iif(lrandom(2,seconds()*70+ct)==1, .T. , .F.)
      replace C19 with (FnumRand(1000000,seconds()*100+(ct*8.4)))/100  // campoNumerico()
      replace C20 with Fpalavra(1025,seconds()*100+(ct*9))
      
      ++numVerifica
      if (numVerifica==10000)
         Main.statusbar.item(1) := "Gravando Registros: " + alltrim(str(ct))
         Main.show()
         numverifica:=0
      endif
   next
   commit   
      
   Main.show()   
   
   // INDEXANDO:
   campos := Dbstruct()
   
   for ct:= 1 to len(campos)
      nCampo := campos[ct][1]
      if (Upper(campos[ct][2]) != "M") 
         index on &nCampo tag &nCampo to DBFMAX
         commit
         Main.statusbar.item(1) := "Indexando: " + campos[ct][1]
         Main.show()
      endif
      Main.campos.item(ct):= nCampo + "["+campos[ct][2]+"]"
   next   
   
   Main.campos.value := 1
   Main.show()
   
   set index to DBFMAX
   dbgotop()
   commit
   close all
   
   MAIN.TABELA.VALUE := "DBFMAX.DBF"
   
   Main.statusbar.item(1) := ""
   Msginfo("Fim da Indexação!"+QUEBRA+;
            "Agora você pode começar a utilizar o sistema de filtragem!","Sucesso")   

RETURN
// --------------------------------------------------------------------------
function mudarCampo()
   local campo := Main.campoS.value, tipo
   
   tipo:= Main.campos.item(campo)
   MAIN.LIMITE.ENABLED := .T.
   MAIN.FILTRO.ENABLED := .T.
   MAIN.LOGICA.ENABLED := .T.
   MAIN.BUSCAr.VALUE := "Buscar:"
   
   DO CASE
      CASE "[C]" $ TIPO .OR. "[M]" $ TIPO
         MAIN.LOGICA.DELETEALLITEMS
         MAIN.LOGICA.ITEM(1) := " EXATAMENTE IGUAL == "
         MAIN.LOGICA.ITEM(2) := " IGUAL = "
         MAIN.LOGICA.ITEM(3) := " EXATAMENTE IGUAL == (INICIO) "
         MAIN.LOGICA.ITEM(4) := " IGUAL = (INICIO) "
         MAIN.LOGICA.ITEM(5) := " EXATAMENTE CONTIDO "
         MAIN.LOGICA.ITEM(6) := " CONTIDO "
         MAIN.LIMITE.DATATYPE.VALUE :=  "Character"
         MAIN.LIMITE.VALUE := ""
         MAIN.LIMITE.ENABLED := .F.
     CASE "[L]" $ TIPO
         MAIN.FILTRO.ENABLED := .F.
         MAIN.LOGICA.DELETEALLITEMS
         MAIN.LOGICA.ITEM(1) := " VERDADEIRO .T. "
         MAIN.LOGICA.ITEM(2) := " FALSO .F. "
         MAIN.LIMITE.DATATYPE.VALUE :=  "Character"
         MAIN.LIMITE.VALUE := ""
         MAIN.LIMITE.ENABLED := .F.
     CASE "[D]" $ TIPO .OR. "[N]" $ TIPO
         MAIN.BUSCAr.VALUE := "Início:"
         MAIN.LIMITE.ENABLED := .T.
         MAIN.LOGICA.DELETEALLITEMS
         MAIN.LOGICA.ENABLED := .F.
         
         IF "[D]" $ tipo
            MAIN.LIMITE.DATATYPE.VALUE :=  "DATE"
            // MAIN.LIMITE.VALUE := DTOC(DATE())
         else
            MAIN.LIMITE.DATATYPE.VALUE :=  "NUMERIC"
            //MAIN.LIMITE.VALUE := "0"
         endif
         
         MAIN.LIMITE.ENABLED := .T.
     ENDCASE    
     
     MAIN.LOGICA.VALUE:=1

return
// ===============================================================================
function adicionarCondicao()
   local campo := Main.campos.value, tipo, busca := alltrim(Main.filtro.value),;
         selecao:=0, relacao:="", fim := alltrim(Main.limite.value)
   
   tipo:= Main.campos.item(campo)  // verificando o tipo de campo
   
   DO CASE
      CASE "[C]" $ TIPO .OR. "[M]" $ TIPO
         tipo := strtran(tipo,"[C]","")
         tipo := strtran(tipo,"[M]","")
         
         selecao := Main.logica.value  // logica selecionada
         IF selecao == 1   // exatamente igual
            relacao += "('"+busca+"' == "+ tipo +")"
         ELSEIF selecao == 2  // igual (não diferencia maiusculas de minusculas)
            relacao += "('"+ HMG_UPPER(busca)+"' == HMG_UPPER("+tipo+"))"
         ELSEIF selecao == 3  // inicio igual
            tam := alltrim(str(hmg_len(busca)))
            relacao += "('"+ busca +"' == HB_USUBSTR("+tipo+",1,"+tam+"))"
         ELSEIF selecao == 4 // inicio igual não diferencia caixa alta/baixa
            tam := alltrim(str(hmg_len(busca)))
            relacao += "('"+ HMG_UPPER(busca) +"' == HMG_UPPER(HB_USUBSTR("+tipo+",1,"+tam+")))"
         ELSEIF selecao == 5 // EXATAMENTE CONTIDO
            relacao += "('"+ busca +"' $ " + tipo +")"
         ELSEIF selecao == 6 // CONTIDO
            relacao += "('"+ HMG_UPPER(busca) +"' $ HMG_UPPER("+tipo+"))"   
         ENDIF   
         Main.lista.additem(relacao)
         
     CASE "[L]" $ TIPO
          tipo := strtran(tipo,"[L]","")
          
          selecao := Main.logica.value  // logica selecionada
          IF selecao == 1   // VERDADEIRO
            relacao += "("+TIPO+" == .T. )"
         ELSEIF selecao == 2  // FALSO
            relacao += "("+TIPO+" == .F. )"
         ENDIF
         Main.lista.additem(relacao)
     
     CASE "[D]" $ TIPO .OR. "[N]" $ TIPO
         IF "[D]" $ tipo
            MAIN.LIMITE.DATATYPE.VALUE :=  "DATE"
            bIni := CTOD(alltrim(Main.filtro.value))
            Bfim := CTOD(alltrim(Main.limite.value))
            tipo := strtran(tipo,"[D]","")
            
            if (Bfim < bIni)
               msgstop("Data inicial não pode ser maior que a data final!!!","ERRO")
               return
            endif
            
            relacao := "(ctod('"+busca+"') <= "+ tipo +" .AND. ctod('"+dtoc(bfim)+"') >= "+ tipo +")"
            Main.lista.additem(relacao)
         else
            MAIN.LIMITE.DATATYPE.VALUE :=  "NUMERIC"
            bIni := val(Main.filtro.value)
            Bfim := val(Main.limite.value)
            tipo := strtran(tipo,"[N]","")
            
            if (Bfim < bIni)
               msgstop("Número inicial não pode ser maior que o Número final!!!","ERRO")
               return
            endif
            relacao := "("+alltrim(busca)+" <= "+ tipo +" .AND. "+alltrim(str(bfim))+" >= "+ tipo +")"
            Main.lista.additem(relacao)
            
         endif
         
     ENDCASE    
     
     MAIN.LOGICA.VALUE:=1
     mudarCampo()
return


// ================================================================================
function validar()
   if !verificaLimite()
      return .f.
   else
      if !verificalimite(Main.filtro.value)
         return .f.
      endif   
   endif
   
   adicionarcondicao()
   
return .t.

// ----------------------------------------------------------------------------------
function verificaLimite(lBusca)
   local campo := ALLTRIM(Main.limite.value), tipo, ct, ret := .T.

   tipo:= main.campoS.item(main.campos.value)
   IF ("[L]" $ TIPO)
      RETURN .T.
   ENDIF
   
   if lbusca<> NIL
      campo := lbusca
      if len(alltrim(campo))==0 
          msgstop("Valor da busca não pode ser vazio!","ERRO")
         RETURN .F.
     endif
   endif
   
   
   DO CASE
     CASE "[N]" $ TIPO
         for ct:= 1 to len(campo)   
            if !isdIGIT(HB_USUBSTR(CAMPO,CT,1)) 
               if HB_USUBSTR(CAMPO,CT,1)!="."
                  msgstop("valor da busca (início ou fim) não é um número","ERRO")
                  RETURN .F.
               endif   
            endif
         next
         verifica:=0
         for ct:= 1 to len(campo)   
            if HB_USUBSTR(CAMPO,CT,1)=="."
               ++verifica
            endif
         next
         if verifica > 1
               msgstop("Número deve ter somente um separador decimal (.)!!!","ERRO")
               RETURN .F.
         endif
     
     CASE "[D]" $ TIPO
         if (len(campo) <> 10)
            msgsTop("Formato de data inválida!","ERRO")
            return .F.
         endif
     
         if (substr(campo,3,1) != "/" .or. substr(campo,6,1) != "/")
            msgsTop("Formato de data inválida!","ERRO")
            return .F.
         endif
         
         lAno := val(substr(campo,7,4))
         lmes := val(substr(campo,4,2))
         lDia := val(substr(campo,1,2))
         
         if lAno<1900 .or. lANo > 2020
            msgsTop("O ano deve estar entre 1900 e 2020","ERRO")
            return .F.
         endif
         
         if lmes<1 .or. lmes > 12
            msgsTop("O Mês é inválido!","ERRO")
            return .F.
         endif
         
         if (lmes==1) .or. (lmes==3) .or. (lmes==5) .or. (lmes==7) .or.;
             (lmes==8) .or. (lmes==10) .or. (lmes==12)
              if (ldia<1 .or. ldia>31)    
                  msgsTop("O dia é inválido!","ERRO")
                  return .F.
              endif 
         elseif (lmes==2)    
            if (ldia>29 .or. ldia<1)
                  msgsTop("O dia é inválido!","ERRO")
                  return .F.
            endif
            
            if (lano%4)<>0 .and. ldia > 28
                  msgsTop("O dia é inválido porque o ano não é bissexto!","ERRO")
                  return .F.
            elseif ldia > 28 .and. (lano%4)==0
                  if (lano%100)==0 
                     if (lano%400)!=0 
                        msgsTop("O dia é inválido porque o ano não é bissexto!","ERRO")
                        return .F.
                     endif
                  endif
            endif
            
         else
              if (ldia<1 .or. ldia>30)    
                  msgsTop("O dia é inválido!","ERRO")
                  return .F.
              endif 
         endif
         
         
     ENDCASE    
return RET

// ===============================================================================
function retiraItem()
   local itemLista := main.lista.value
   
   if Main.lista.itemcount == 0 .or. itemLista==0
      return
   endif

   Main.lista.deleteItem(itemLista)
   // MsgInfo("Um filtro foi retirado!!!")

return
// =============================================================================
function lrandom(limite,semente)
return fnumrand(limite,semente+(ct%32123*(seconds()*100)%65537))
// ================================================================================
function campoData()
   local data_aleat := ""
   
   data_aleat := strzero(lrandom(28,seconds()*100+ct)+1,2) + "/" + strzero(lrandom(12,seconds()*100+ct+1)+1,2) +;
               "/" + strzero(lrandom(120,seconds()*100+ct+2)+1900,4)  
               
   data_aleat := ctod(data_aleat) + lrandom(365,seconds()*100+Memory(0))
     
return (data_aleat)
// =========================================================================
FUNCTION preencherGrid(xfiltro)
   local colunas:={}, ct, tabela:= Main.tabela.value, itemGrid
   
   tIni:=seconds()
   
   use &tabela
   if xFiltro == nil
      set filter to
      go top
   else
      Main.statusbar.item(1) := "Aguarde, filtrando..."
      Main.show()
      set filter to &xfiltro
      go top
   endif
   campos := Dbstruct()
   
   teste = main.banco.itemcount  // total de linhas do grid
   linha := main.banco.item(teste)
   
   // msgbox(len(linha))  // total de colunas do grid

   Main.banco.deleteallitems   
   for ct:= len(linha) to 1 step -1  // é preciso deletar as colunas em ordem inversa
      // Main.statusbar.item(1) := ct
      // Main.show()
      Main.banco.deletecolumn(ct) // deleta a coluna inicial
   next

   
   for ct:= 1 to LEN(CAMPOS)
      // aadd(colunas,CAMPOS[CT][1])
      nCampo := campos[ct][1]
      Main.banco.addcolumn(CT, NCAMPO,200, "CENTER")
      // Main.banco.Header(ct):=nCampo
   next
   Main.banco.refresh

   count to filRecords  // CALCULA RESGISTROS FILTRADOS...
   go top
   
   limite := 1000
   
   if xfiltro <> nil .AND. !empty(XFILTRO)
      limite := filRecords
      if limite > 1000
         MsgInfo("FORAM ENCONTRADOS " + alltrim(str(filrecords)) + " REGISTROS QUE ATENDEM A "+;
            "CONDIÇÃO DE FILTRO. VÃO SER APRESENTADOS OS PRIMEIROS 1.000 REGISTROS FILTRADOS","AVISO")
         limite := 1000   
      endif
   endif
   
   for ct:= 1 to limite
      itemGrid := {c01,dtoc(c02),iif(c03,"T","F"),alltrim(str(c04)),c05,;
               c06,dtoc(c07),iif(c08,"T","F"),alltrim(str(c09)),c10,;
               c11,dtoc(c12),iif(c13,"T","F"),alltrim(str(c14)),c15,;
               c16,dtoc(c17),iif(c18,"T","F"),alltrim(str(c19)),c20}
               
      Main.banco.additem(itemGrid)
      skip
      if eof()
         exit
      endif
   next
   
   Main.statusbar.item(1) := "OK!!!"
   Main.show()

   main.banco.refresh
   tfim = "TEMPO DE PROCESSAMENTO: " + str(seconds() - tini)
   
   if xfiltro <> nil .AND. !empty(XFILTRO)
      msginfo("FIM DA FILTRAGEM" + QUEBRA + QUEBRA + tfim + QUEBRA + ;
             "TOTAL DE REGISTROS: " + alltrim(str(lastrec())) + QUEBRA +;
             "REGISTROS FILTRADOS: " + str(filRecords)      )
   endif
   
   close all
return 
    
// ==========================================================
function setfilterClipper()    
   local ct , filtro:="", tot := Main.lista.itemcount

   for ct:= 1 to tot
      if ct <> tot   
         filtro := filtro + Main.lista.item(ct) + " .AND. "
      else
         filtro := filtro + Main.lista.item(ct)
      endif   
   next

   if !empty(filtro)
      msginfo("filtro..: " + QUEBRA+ filtro)
   endif
   
   preencherGrid(filtro)
   
return
// ========================================================
function mostraRegistro()
        Load Window Registro
        Registro.Center
        Registro.Activate
return
// ==========================================================
function mostraDados()
   local campos:= {}, verifica:={},tot:=0, ct, regTexto:="", linha, registro, ct2
   
   verifica := Main.banco.itemcount
   linha := main.banco.item(verifica)
   tot := len(linha)
   
   regTexto := ""
   registro := Main.banco.item(Main.banco.value)
         
   for ct:= 1 to tot
      regTexto += Main.banco.header(ct) + ": " + registro[ct] + QUEBRA +;
                replicate("-",300) + QUEBRA
   next
   
   Registro.mostraReg.Value:= regTexto
   
return

// ========================================================
#pragma BEGINDUMP
   
   #include <stdio.h>
   #include<stdlib.h>
	#include<time.h>
   #include "hbapi.h"
  
   HB_FUNC ( FNUMRAND )  // retorna uma numero randomico
{
   	unsigned int number, limite, i;
      unsigned long int semente;
      
      limite = (int)hb_parni(1);
      semente = (unsigned long int)hb_parnl(2);
		srand( semente );
		
      hb_retni(rand()%limite);
}   
// -------------------------------------------------------------------------------------
   HB_FUNC ( FPALAVRA )  // retorna uma string randomica
{
     	unsigned int number, limite=(int)hb_parni(1);
      unsigned long int semente,i;
      char palavra[64] = "0123456789 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
      char retorno[limite]; 
      
      semente = (unsigned long int)hb_parnl(2);
		srand( semente );
		
      for(i=0 ; i < limite; i++) {
           number = rand()%63;
           retorno[i] = palavra[number];
      }
      
      hb_retc(retorno);
}   

#pragma ENDDUMP   // fim do código em C
Os testes que executei se baseiam numa tabela com 1.000.000 de registros e com 20 campos, contendo caracter, data, número, Lógico e memo.
Parece que o comando set filter to responde bem a filtros complexos, excetuando os campos MEMO (Não consegui indexar este tipo de campo, não sei se é possivel...)

Código completo em anexo.
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB