Também poderia ser variável HASH, mas por #define, o compilador confere se digitarmos errado, ao compilar usando -w3 -es2
oElement[ "CAMPO" ]
oElement[ "TIPOCOMPARACAO" ]
oElement[ "DESDE" ]
oElement[ "ATE" ]

Moderador: Moderadores
/*
PTESFILTRO - Teste do filtro automatico
José Quintas
*/
#include "hbclass.ch"
#include "inkey.ch"
#include "achoice.ch"
#define FILTER_FIELD 1
#define FILTER_TYPE 2
#define FILTER_RANGEFROM 3
#define FILTER_RANGETO 4
#define FIELD_NAME 1
#define FIELD_SELECTED 2
#define FIELD_EMPTYVALUE 3
#define TYPE_NO_FILTER 1 //
#define TYPE_EQUAL 2 // =
#define TYPE_GREATHER_OR_EQUAL 3 // >=
#define TYPE_LESS_OR_EQUAL 4 // <=
#define TYPE_GREATHER 5 // >
#define TYPE_LESS 6 // <
#define TYPE_NOT_EQUAL 7 // !=
#define TYPE_RANGE 8 // >= rangefrom .AND. <= rangeto
#define TYPE_HAS_TEXT 9 // text $ field
#define TYPE_NOT_HAS_TEXT 10 // ! text $ field
#define TYPE_BEGIN_WITH_TEXT 11 // field = text*
#define TYPE_IN_TEXT 12 // field $ text
#define TYPE_NOT_IN_TEXT 13 // ! field $ text
MEMVAR acFields // pra achoice
MEMVAR oFilter // pras funções
PROCEDURE PTESFILTRO
PRIVATE oFilter
IF ! AbreArquivos( "jpctplano" )
RETURN
ENDIF
oFilter := FilterClass():New()
oFilter:Execute()
CLOSE DATABASES
RETURN
CREATE CLASS FilterClass
VAR aFieldList INIT {}
VAR aFilterList INIT { { "NONE", TYPE_NO_FILTER, "", "" } }
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
METHOD SelectFields()
METHOD GetFieldFilter( oFilter )
METHOD Execute()
METHOD Browse( nTop, nLeft, nBottom, nRight )
ENDCLASS
METHOD Init() CLASS FilterClass
LOCAL acStru, nCont, xValue
acStru := dbStruct()
FOR nCont = 1 TO Len( acStru )
xValue := EmptyValue( FieldGet( nCont ) )
Aadd( ::aFieldList, { FieldName( nCont ), .F., xValue } )
NEXT
RETURN NIL
METHOD Filter() Class FilterClass
LOCAL oElement, lReturn := .T., xValue
FOR EACH oElement IN ::aFilterList
xValue := FieldGet( FieldPos( oElement[ FIELD_NAME ] ) )
DO CASE
CASE oElement[ FILTER_TYPE ] == TYPE_NO_FILTER
CASE oElement[ FILTER_TYPE ] == TYPE_EQUAL ; lReturn := ( xValue == oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_GREATHER_OR_EQUAL ; lReturn := ( xValue >= oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_LESS_OR_EQUAL ; lReturn := ( xValue <= oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_GREATHER ; lReturn := ( xValue > oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_LESS ; lReturn := ( xValue < oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_NOT_EQUAL ; lReturn := ( xValue != oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_RANGE ; lReturn := ( xValue >= oElement[ FILTER_RANGEFROM ] .AND. xValue <= oElement[ FILTER_RANGETO ] )
CASE oElement[ FILTER_TYPE ] == TYPE_HAS_TEXT ; lReturn := ( Trim( oElement[ FILTER_RANGEFROM ] ) $ xValue )
CASE oElement[ FILTER_TYPE ] == TYPE_NOT_HAS_TEXT ; lReturn := ( ! Trim( oElement[ FILTER_RANGEFROM ] ) $ xValue )
CASE oElement[ FILTER_TYPE ] == TYPE_BEGIN_WITH_TEXT ; lReturn := ( Substr( xValue, 1, Len( Trim( oElement[ FILTER_RANGEFROM ] ) ) ) == Trim( oElement[ FILTER_RANGEFROM ] ) )
CASE oElement[ FILTER_TYPE ] == TYPE_IN_TEXT; lReturn := ( xValue $ oElement[ FILTER_RANGEFROM ] )
CASE oElement[ FILTER_TYPE ] == TYPE_NOT_IN_TEXT; lReturn := ( ! xValue $ oElement[ FILTER_RANGEFROM ] )
ENDCASE
IF ! lReturn
EXIT
ENDIF
NEXT
RETURN lReturn
METHOD FilterAsString() CLASS FilterClass
LOCAL xValue, oElement
xValue := ""
FOR EACH oElement IN ::aFilterList
IF oElement[ FILTER_TYPE ] != TYPE_NO_FILTER
xValue += oElement[ FIELD_NAME ] + " "
xValue += ::FilterOptions()[ oElement[ FILTER_TYPE ] ] + " "
IF oElement[ FILTER_TYPE ] == TYPE_RANGE
xValue += Trim( Transform( oElement[ FILTER_RANGEFROM ], "" ) ) + " to "
xValue += Trim( Transform( oElement[ FILTER_RANGETO ], "" ) )
ELSE
xValue += Trim( Transform( oElement[ FILTER_RANGEFROM ], "" ) )
ENDIF
xValue += ", "
ENDIF
NEXT
RETURN xValue
METHOD FilterOptionsAsArray( lIncludeAll ) CLASS FilterClass
LOCAL xValue, acTxtFiltros := {}, oElement
hb_Default( @lIncludeAll, .T. )
FOR EACH oElement IN ::aFilterList
xValue := oElement[ FILTER_FIELD ] + " "
IF oElement[ FILTER_TYPE ] == TYPE_NO_FILTER
xValue += " No Filter "
ELSE
xValue += ::FilterOptions()[ oElement[ FILTER_TYPE ] ] + " "
IF oElement[ FILTER_TYPE ] == TYPE_RANGE
xValue += Trim( Transform( oElement[ FILTER_RANGEFROM ], "" ) ) + " to " + xValue + Trim( Transform( oElement[ FILTER_RANGETO ], "" ) )
ELSE
xValue += Trim( Transform( oElement[ FILTER_RANGEFROM ], "" ) )
ENDIF
ENDIF
IF oElement[ FILTER_TYPE ] != TYPE_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", "Range", "Have Text", "Haven't Text", "Begin With", "In Text", "Not In Text" }
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 nOpcField := 1, nCont, acTxtActive, nOpcActive := 1, lOk, oElement
PRIVATE acFields
wOpen( 5, 0, 20, 80, "Filter" )
DO WHILE .t.
acTxtActive := ::FilterOptionsAsArray( .f. )
aSize( acTxtActive, Len( acTxtActive ) + 4 )
FOR nCont = 1 TO 4
AIns( acTxtActive, 1 )
NEXT
acTxtActive[ 1 ] := "Select Fields"
acTxtActive[ 2 ] := "Show Data"
acTxtActive[ 3 ] := "Change Filter"
acTxtActive[ 4 ] := "Reset"
nOpcActive := Min( nOpcActive, Len( acTxtActive ) )
Scroll( 7, 1, 19, 79, 0 )
Achoice( 7, 1, 19, 79, acTxtActive, .t. ,,@nOpcActive )
DO CASE
CASE LastKey() == K_ESC
EXIT
CASE nOpcActive == 1
::SelectFields()
LOOP
CASE nOpcActive == 2
lOk := .F.
FOR EACH oElement IN ::aFieldList
IF oElement[ FIELD_SELECTED ]
lOk := .T.
EXIT
ENDIF
NEXT
IF ! lOk
Alert( "If you do not select fields, no filter to show" )
LOOP
ENDIF
EXIT
CASE nOpcActive == 4
::aFilterList := {}
LOOP
ENDCASE
wOpen( 5, 0, 20, 80, "Field To Filter" )
DO WHILE .t.
Achoice( 7, 1, 19, 79, ::FilterOptionsAsArray(), .t., { | ... | UDFFilter(...) }, @nOpcField )
IF LastKey() == K_ESC
EXIT
ENDIF
ENDDO
wClose()
ENDDO
wClose()
RETURN LastKey() != K_ESC
STATIC FUNCTION UDFFilter( nModo, nElemento, nSelecao ) // Used in METHOD SelectFields()
LOCAL oItem, nOpc
PRIVATE acFields
IF LastKey() == K_ESC
RETURN AC_ABORT
ELSEIF LastKey() == K_DEL
IF nElemento != 1
hb_ADel( oFilter:aFilterList, nElemento, .T. )
ENDIF
RETURN AC_REDRAW
ELSEIF LastKey() == K_ENTER
IF nElemento == 1
RETURN 2
ENDIF
wOpen( 6, 10, 20, 60, "Filter Type" )
DO WHILE .t.
Achoice( 8, 11, 19, 59, oFilter:FilterOptions, .t.,, @oFilter:aFilterList[ nElemento, FILTER_TYPE ] )
IF LastKey() == K_ESC
EXIT
ENDIF
oFilter:GetFieldFilter( oFilter:aFilterList[ nElemento ] )
EXIT
ENDDO
wClose()
RETURN AC_REDRAW
ELSEIF LastKey() == K_INS
acFields := {}
FOR EACH oItem IN oFilter:aFieldList
AAdd( acFields, oItem[ FIELD_NAME ] )
NEXT
wOpen( 7, 10, 20, 80, "Field" )
nOpc := Achoice( 8, 11, 19, 79, acFields )
IF LastKey() != K_ESC
AAdd( oFilter:aFilterList, { ;
oFilter:aFieldList[ nOpc, FIELD_NAME ], ;
TYPE_NO_FILTER, ;
oFilter:aFieldList[ nOpc, FIELD_EMPTYVALUE ], ;
oFilter:aFieldList[ nOpc, FIELD_EMPTYVALUE ] } )
ENDIF
wClose()
RETURN AC_REDRAW
ENDIF
HB_SYMBOL_UNUSED( nModo + nSelecao )
RETURN AC_CONT
METHOD SelectFields() CLASS FilterClass
LOCAL oItem
PRIVATE acFields := {}
FOR EACH oItem IN ::aFieldList
AAdd( acFields, iif( oItem[ FIELD_SELECTED ], "*", " " ) + " " + oItem[ FIELD_NAME ] )
NEXT
wOpen( 7, 10, 20, 80, "Select Fields" )
AChoice( 8, 11, 19, 79, acFields, "", { | ... | UDFSelectField( ... ) } )
wClose()
FOR EACH oItem IN acFields
::aFieldList[ oItem:__EnumIndex, FIELD_SELECTED ] := ( Left( oItem, 1 ) == "*" )
NEXT
RETURN NIL
METHOD GetFieldFilter( oFilter ) CLASS FilterClass
LOCAL GetList := {}
DO CASE
CASE oFilter[ FILTER_TYPE ] == TYPE_NO_FILTER
CASE oFilter[ FILTER_TYPE ] == TYPE_RANGE
wOpen( 10, 20, 16, 80, "From/To" )
SetColor( "W/B,N/W,,,W/B" )
IF ValType( oFilter[ FILTER_RANGEFROM ] ) == "C"
IF Len( oFilter[ FILTER_RANGEFROM ] ) > 48
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ] PICTURE "@!S 48"
@ 14, 22 GET oFilter[ FILTER_RANGETO ] PICTURE "@!S 48"
ELSE
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ] PICTURE "@!"
@ 14, 22 GET oFilter[ FILTER_RANGETO ] PICTURE "@!"
ENDIF
ELSE
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ]
@ 14, 22 GET oFilter[ FILTER_RANGETO ]
ENDIF
READ
wClose()
CASE hb_ASCan( { TYPE_HAS_TEXT, TYPE_NOT_HAS_TEXT, TYPE_BEGIN_WITH_TEXT }, oFilter[ FILTER_TYPE ] ) != 0
IF ValType( oFilter[ FILTER_RANGEFROM ] ) != "C"
Alert( "Valid only for String" )
ELSE
wOpen( 10, 20, 15, 80, "Value To Compare" )
SetColor( "W/B,N/W,,,W/B" )
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ] PICTURE "@!"
READ
wClose()
ENDIF
OTHERWISE
wOpen( 10, 20, 15, 80, "Value To Compare" )
SetColor( "W/B,N/W,,,W/B" )
IF ValType( oFilter[ FILTER_RANGEFROM ] ) == "C"
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ] PICTURE "@!"
ELSE
@ 12, 22 GET oFilter[ FILTER_RANGEFROM ]
ENDIF
READ
wClose()
ENDCASE
RETURN NIL
METHOD Execute() CLASS FilterClass
LOCAL nQtdRec
DO WHILE .T.
IF ! ::ChooseFilter()
EXIT
ENDIF
SET FILTER TO ::Filter()
COUNT TO nQtdRec
SetColor( SetColorNormal() )
@ 1, 0 SAY "Records in Filter:" + Str( nQtdRec )
::Show( MaxRow() - 2, 0, MaxRow(), MaxCol() )
::Browse( 2, 0, MaxRow() - 4, MaxCol() )
SET FILTER TO
ENDDO
RETURN NIL
METHOD Browse( nTop, nLeft, nBottom, nRight ) CLASS FilterClass
LOCAL oBrowse, oElement, nKey
oBrowse := tBrowseDb( nTop, nLeft, nBottom, nRight )
FOR EACH oElement IN ::aFieldList
IF oElement[ FIELD_SELECTED ]
oBrowse:AddColumn( TBColumnNew( oElement[ FIELD_NAME ], FieldBlock( oElement[ FIELD_NAME ] ) ) )
ENDIF
NEXT
GOTO TOP
DO WHILE .T.
DO WHILE ! oBrowse:Stable
oBrowse:Stabilize()
ENDDO
nKey := Inkey(0)
IF nKey == K_ESC
EXIT
ENDIF
oBrowse:ApplyKey( nKey )
ENDDO
Scroll( nTop, nLeft, nBottom, nRight, 0 )
RETURN NIL
STATIC FUNCTION UDFSelectField( nModo, nElemento, nSelecao ) // Used in METHOD SelectFields()
IF LastKey() == K_SPACE
acFields[ nElemento ] := iif( Left( acFields[ nElemento ], 1 ) == "*", " ", "*" ) + Substr( acFields[ nElemento ], 2 )
ELSEIF LastKey() == K_ESC .OR. Lastkey() == K_ENTER
RETURN AC_ABORT
ENDIF
HB_SYMBOL_UNUSED( nModo + nSelecao )
RETURN AC_CONT
nRow := 100
nPag := 0
aCamposList := dbStruct()
DO WHILE ! Eof()
IF nRow > 66 // cabeçalho
IF nPag != 0
EJECT
ENDIF
nPag += 1
@ 0, 0 SAY "RELATORIO - PAGINA " + Str( NPag, 6 )
nRow := 0
FOR EACH aCampo IN aCamposList
@ 1, Col() + 2 SAY aCampo[ F_NAME ]
NEXT
@ 2, 0 SAY Replicate( "-", 100 )
nRow := 3
ENDIF
FOR EACH aCampo IN aCamposList
@ nRow, pCol() + 2 SAY &( aCampo[ F_NAME ] )
NEXT
nRow += 1
SKIP
ENDDO
Retornar para Interface com Clientes
Usuários vendo este fórum: Nenhum usuário registrado online e 2 visitantes