Se alguém tiver alguma idéia.
/*
ZE_BROWSEADO.PRG - Browse para ADO
*/
#include "inkey.ch"
#include "josequintas.ch"
FUNCTION BrowseADORC( nTop, nLeft, nBottom, nRight, cnSQL, oTBrowse, cFilterKey, bKeyboard, bUserFunction, nFixToCol, cAddFilter )
LOCAL nKey := 0, oBrowse, bAction, nMRow, nMCol, cTimeLimit
LOCAL cFilter := "", lAddFilter := .F.
hb_Default( @cAddFilter, "" )
IF ! Empty( cAddFilter )
lAddFilter := .T.
ADOFilter( cnSQL, cFilterkey, cFilter, cAddFilter )
ENDIF
oBrowse := TBrowseDb():New( nTop, nLeft, nBottom, nRight )
oBrowse:HeadSep := Chr(196)
oBrowse:ColSep := Chr(179)
oBrowse:FootSep := ""
oBrowse:FrameColor := "2/1"
oBrowse:HeaderColor := "7/8"
oBrowse:GoTopBlock := { || cnSQL:MoveFirst() }
oBrowse:GoBottomBlock := { || cnSQL:MoveLast() }
oBrowse:SkipBlock := { | n | cnSQLBrowseSkipper( cnSQL, n ) }
IF nFixToCol != NIL
oBrowse:freeze := nFixToCol
ENDIF
ToBrowse( oTBrowse, oBrowse )
oBrowse:ColorSpec := SetColorTBrowse()
DO WHILE ! oBrowse:Stable()
oBrowse:Stabilize()
ENDDO
MsgBrowse( cFilter, cFilterKey )
DO WHILE .T.
oBrowse:RefreshCurrent()
DO WHILE nKey == 0 .AND. ! oBrowse:Stable
oBrowse:Stabilize()
nKey := Inkey()
ENDDO
oBrowse:RefreshCurrent()
IF nKey == 0
DO WHILE ! oBrowse:Stabilize()
ENDDO
IF ! Empty( oBrowse:Freeze )
oBrowse:ColorRect( { oBrowse:RowPos, 1, oBrowse:RowPos, oBrowse:Freeze }, { 3, 3 } )
ENDIF
oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:LeftVisible, oBrowse:RowPos, oBrowse:RightVisible }, { 3, 3 } )
oBrowse:ColorRect( { oBrowse:RowPos, oBrowse:ColPos, oBrowse:RowPos, oBrowse:ColPos }, { 2, 2 } )
cTimeLimit := TimeAdd( Time(), "M", 10 )
nKey := Inkey( INKEY_IDLE, HB_INKEY_ALL - INKEY_MOVE + HB_INKEY_GTEVENT )
IF nKey == 0 .AND. Time() > cTimeLimit
KEYBOARD Chr( K_ESC )
LOOP
ENDIF
ENDIF
IF ( bAction := SetKey( nKey ) ) != NIL
Eval( bAction, ProcName(), ProcLine(), ReadVar() )
ENDIF
nMRow := MROW()
nMCol := MCOL()
DO CASE
CASE nKey > 999
DO CASE
CASE mBrzMove( oBrowse, nMRow, nMCol, nTop + 1, nLeft + 1, nBottom - 1, nRight - 1 )
CASE mBrzClick( oBrowse, nMRow, nMCol )
nKey := 0
KEYBOARD Chr( K_ENTER )
LOOP
ENDCASE
CASE nKey == K_ENTER .AND. bUserFunction == NIL
DO WHILE ! oBrowse:Stable
oBrowse:Stabilize()
ENDDO
IF bKeyboard != NIL
IF ValType( Eval( bKeyboard ) ) == "N"
KEYBOARD Ltrim( Str( Eval( bKeyBoard ), 16, 0 ) ) + Chr( K_ENTER )
ELSE
KEYBOARD Eval( bKeyBoard ) + Chr( K_ENTER )
ENDIF
ENDIF
EXIT
CASE nkey == K_CTRL_PGDN ; nKey := 0; oBrowse:GoBottom() ; LOOP
CASE nkey == K_CTRL_PGUP ; nKey := 0; oBrowse:GoTop() ; LOOP
CASE nkey == K_DOWN ; nKey := 0; oBrowse:Down() ; LOOP
CASE nkey == K_HOME ; nKey := 0; oBrowse:GoTop() ; LOOP
CASE nkey == K_END ; nKey := 0; oBrowse:GoBottom() ; LOOP
CASE nkey == K_LEFT ; nKey := 0; oBrowse:Left() ; LOOP
CASE nkey == K_RIGHT ; nKey := 0; oBrowse:Right() ; LOOP
CASE nkey == K_PGDN ; nKey := 0; oBrowse:PageDown() ; LOOP
CASE nkey == K_PGUP ; nKey := 0; oBrowse:PageUp() ; LOOP
CASE nkey == K_UP ; nKey := 0; oBrowse:Up() ; LOOP
CASE nKey == K_ESC ; EXIT
CASE nKey == K_ALT_F .AND. ! Empty( cAddFilter )
lAddFilter := ! lAddFilter
ADOFilter( cnSQL, cFilterKey, cFilter, iif( lAddFilter, cAddFilter, "" ) )
oBrowse:RefreshAll()
CASE nKey == K_BS .AND. cFilterKey != NIL
IF Len( cFilter ) < 2
cFilter := ""
ADOFilter( cnSQL, cFilterKey, cFilter, iif( lAddFilter, cAddFilter, "" ) )
ELSE
cFilter := iif( Len( cFilter ) == 0, "", Left( cFilter, Len( cFilter ) - 1 ) )
ADOFilter( cnSQL, cFilterkey, cFilter, iif( lAddFilter, cAddFilter, "" ) )
ENDIF
MsgBrowse( cFilter, cFilterKey )
oBrowse:RefreshAll()
CASE IsRange( nKey, 32, 127 ) .AND. cFilterKey != NIL .AND. ! cnSQL:Eof()
IF Chr( nKey ) $ ['/*]
nKey := 32
ENDIF
cFilter += Upper( Chr( nKey ) )
IF ! ADOFilter( cnSQL, cFilterKey, cFilter, iif( lAddFilter, cAddFilter, "" ) )
cFilter := Left( cFilter, Len( cFilter ) - 1 )
IF Len( cFilter ) == 0
cnSQL:Filter( "" )
ELSE
ADOFilter( cnSQL, cFilterKey, cFilter, iif( lAddFilter, cAddFilter, "" ) )
ENDIF
ENDIF
MsgBrowse( cFilter, cFilterKey )
oBrowse:RefreshAll()
ENDCASE
IF bUserFunction != NIL
DO WHILE ! oBrowse:Stable
oBrowse:Stabilize()
ENDDO
Eval( bUserFunction, oBrowse, nKey, cnSQL )
oBrowse:RefreshAll()
ENDIF
nKey := 0 // para refresh
ENDDO
@ MaxRow(), MaxCol() SAY ""
RETURN NIL
FUNCTION BrowseADO( cnSQL, oTBrowse, cFilterKey, bKeyboard, bUserFunction, nFixToCol, cAddFilter )
LOCAL nTop := 5, nLeft := 0, nBottom := MaxRow() - 3, nRight := MaxCol(), cColorAnt := SetColor()
LOCAL oFrm
hb_Default( @cAddFilter, "" )
IF cnSQL == NIL
MsgStop( "Não há informações para serem mostradas" )
RETURN NIL
ENDIF
SetColor( SetColorBox() )
IF Len( appForms() ) > 0
Atail( AppForms()):GuiHide()
ENDIF
oFrm := frmGuiClass():New()
oFrm:lNavigate := .F.
oFrm:cOptions := "C"
AAdd( oFrm:acMenuOptions, "<Ctrl-PgUp>Primeiro" )
AAdd( oFrm:acMenuOptions, "<PgUp>Pág.Ant" )
Aadd( oFrm:acMenuOptions, "<Up>Sobe" )
AAdd( oFrm:acMenuOptions, "<Down>Desce" )
AAdd( oFrm:acMenuOptions, "<PgDn>Pág.Seg" )
AAdd( oFrm:acMenuOptions, "<Ctrl-PgDn>Último" )
IF ! Empty( cAddFilter )
AAdd( oFrm:acMenuOptions, "<Alt-F>Filtro" )
ENDIF
wSave()
oFrm:FormBegin()
BrowseADORC( nTop, nLeft, nBottom, nRight, cnSQL, oTBrowse, cFilterKey, bKeyboard, bUserFunction, nFixToCol, cAddFilter )
oFrm:FormEnd()
wRestore()
IF Len( AppForms() ) > 0
Atail( AppForms() ):GuiSHow()
ENDIF
SetColor( cColorAnt )
RETURN NIL
STATIC FUNCTION cnSQLBrowseSkipper( cnSQL, nSkip )
LOCAL nRec := cnSQL:AbsolutePosition()
IF ! cnSQL:Eof()
cnSQL:Move( nSkip )
IF cnSQL:Eof()
cnSQL:MoveLast()
ENDIF
IF cnSQL:Bof()
cnSQL:MoveFirst()
ENDIF
ENDIF
RETURN cnSQL:AbsolutePosition() - nRec
STATIC FUNCTION MsgBrowse( cFilter, cFilterKey )
LOCAL cTxt := ""
IF ! Empty( cFilter )
cTxt += "[" + cFilter + "]"
ENDIF
cTxt += " Selecione e tecle ENTER, "
IF ! Empty( cFilterKey )
cTxt += "texto para filtro, = filtra pelo inicio, "
ENDIF
cTxt += "ESC Sai"
cTxt := AllTrim( cTxt )
Mensagem( cTxt )
RETURN NIL
STATIC FUNCTION ADOFilter( cnSQL, cFilterKey, cFilter, cAddFilter )
cnSQL:Filter( ADOStringFilter( cFilterKey, cFilter, cAddFilter ) )
RETURN ! cnSQL:Eof()
STATIC FUNCTION ADOStringFilter( cFilterKey, cFilter, cAddFilter )
LOCAL cTxt := "", cFilter1, aFilterList, oElement, aFilterKeyList
IF cFilterKey != NIL .AND. ! Empty( cFilterKey ) .AND. ! Empty( cFilter )
aFilterKeyList := hb_RegExSplit( ",", cFilterKey )
IF Left( cFilter, 1 ) == "="
cFilter := Substr( cFilter, 2 )
IF ! Empty( cFilter )
cTxt := aFilterKeyList[ 1 ] + " LIKE '" + Substr( cFilter, 1, At( " ", cFilter + " " ) - 1 ) + "%' "
cFilter := Substr( cFilter, At( " ", cFilter + " " ) )
ENDIF
ENDIF
cFilter := AllTrim( cFilter )
IF ! Empty( cAddFilter )
cTxt := iif( Empty( cTxt ), "", cTxt + " AND " ) + cAddFilter
ENDIF
IF ! Empty( cFilter )
aFilterList := hb_RegExSplit( " ", cFilter )
IF Len( aFilterKeyList ) == 1
cTxt += iif( Len( cTxt ) == 0, "", " AND " ) + ADOSubFilter( aFilterKeyList[ 1 ], aFilterList )
ELSE
cFilter1 := cTxt
cTxt := ""
FOR EACH oElement IN aFilterKeyList
cTxt += iif( Len( cTxt ) == 0, "", " OR " )
cTxt += " ( " + cFilter1 + iif( Empty( cFilter1 ), "", " AND " )
cTxt += ADOSubFilter( oElement, aFilterList )
cTxt += " ) "
NEXT
ENDIF
ENDIF
ENDIF
IF Empty( cTxt ) .AND. ! Empty( cAddFilter )
cTxt := cAddFilter
ENDIF
RETURN cTxt
STATIC FUNCTION ADOSubFilter( cKey, aList )
LOCAL oElement, cTxt := ""
FOR EACH oElement IN aList
IF ! Empty( oElement )
cTxt += iif( Len( cTxt ) == 0, "", " AND " ) + " " + cKey + " LIKE '%" + oElement + "%'"
ENDIF
NEXT
RETURN cTxt
É meio complicado o filtro, pelas limitações do filtro no ADO....
BrowseADO( cnSQL, oTBrowse, "CDNOME,CDENDERECO,CDCNPJ,CDAPELIDO", { || StrZero( :Number( "IDCADASTRO" ), 6 ) }, , 1, "STATUS <> '0'" )
Nesse caso o filtro vai ser por nome,endereço,cnpj,apelido
A rotina separa os nomes, e faz combinações.
STATIC FUNCTION ADOFilter( cnSQL, cFilterKey, cFilter, cAddFilter )
cnSQL:Filter( ADOStringFilter( cFilterKey, cFilter, cAddFilter ) )
RETURN ! cnSQL:Eof()
STATIC FUNCTION ADOStringFilter( cFilterKey, cFilter, cAddFilter )
LOCAL cTxt := "", cFilter1, aFilterList, oElement, aFilterKeyList
IF cFilterKey != NIL .AND. ! Empty( cFilterKey ) .AND. ! Empty( cFilter )
aFilterKeyList := hb_RegExSplit( ",", cFilterKey )
IF Left( cFilter, 1 ) == "="
cFilter := Substr( cFilter, 2 )
IF ! Empty( cFilter )
cTxt := aFilterKeyList[ 1 ] + " LIKE '" + Substr( cFilter, 1, At( " ", cFilter + " " ) - 1 ) + "%' "
cFilter := Substr( cFilter, At( " ", cFilter + " " ) )
ENDIF
ENDIF
cFilter := AllTrim( cFilter )
IF ! Empty( cAddFilter )
cTxt := iif( Empty( cTxt ), "", cTxt + " AND " ) + cAddFilter
ENDIF
IF ! Empty( cFilter )
aFilterList := hb_RegExSplit( " ", cFilter )
IF Len( aFilterKeyList ) == 1
cTxt += iif( Len( cTxt ) == 0, "", " AND " ) + ADOSubFilter( aFilterKeyList[ 1 ], aFilterList )
ELSE
cFilter1 := cTxt
cTxt := ""
FOR EACH oElement IN aFilterKeyList
cTxt += iif( Len( cTxt ) == 0, "", " OR " )
cTxt += " ( " + cFilter1 + iif( Empty( cFilter1 ), "", " AND " )
cTxt += ADOSubFilter( oElement, aFilterList )
cTxt += " ) "
NEXT
ENDIF
ENDIF
ENDIF
IF Empty( cTxt ) .AND. ! Empty( cAddFilter )
cTxt := cAddFilter
ENDIF
RETURN cTxt
STATIC FUNCTION ADOSubFilter( cKey, aList )
LOCAL oElement, cTxt := ""
FOR EACH oElement IN aList
IF ! Empty( oElement )
cTxt += iif( Len( cTxt ) == 0, "", " AND " ) + " " + cKey + " LIKE '%" + oElement + "%'"
ENDIF
NEXT
RETURN cTxt
É que posso digitar "MAR CUN JOS", e isso vai encontrar "JOSE MARIA CUNHA" que contém as tres palavras nao importa a ordem.
Além disso, pode ser no nome, endereco, etc.
Agora pensando em como acrescentar campo numérico como opção de filtro, talvez até data.