Página 1 de 1

Expandir browse ADO

Enviado: 17 Ago 2020 12:50
por JoséQuintas
Estou começando a pensar em como acrescentar no "bolo" o filtro por número.
Se alguém tiver alguma idéia.

Código: Selecionar todos

/*
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....

Código: Selecionar todos

      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.

Código: Selecionar todos

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.

Expandir browse ADO

Enviado: 17 Ago 2020 12:58
por JoséQuintas
cFilterKey são os campos: "CDNOME,CDENDERECO,CDCNPJ,CDAPELIDO"

cAddFilter é o filtro adicional: "STATUS <> '0'", somente clientes ativos

cFilter é o texto que está sendo digitado

Expandir browse ADO

Enviado: 17 Ago 2020 13:04
por JoséQuintas
Ao digitar JPA TEC GIA
filtroado.png

Expandir browse ADO

Enviado: 17 Ago 2020 13:08
por JoséQuintas
Esqueci de dizer.....

Se o usuário digitar "=", símbolo de igual, equivale ao tradicional, de filtrar pelo que começa pelo texto seguinte.
=JPA, tudo que começa com JPA, nesse caso ao invés de LIKE '%JPA%', uso LIKE 'JPA%'

Expandir browse ADO

Enviado: 17 Ago 2020 13:10
por JoséQuintas
Então... pra valor seria campo = valor, mas.... só testando cada campo pra ver se é ou não numérico...
E um pouco mais complicado se o campo for data.

Expandir browse ADO

Enviado: 17 Ago 2020 13:27
por JoséQuintas
Errei....
número = "A" , isso não dá
Tem que testar também o que foi digitado.

Expandir browse ADO

Enviado: 17 Ago 2020 13:42
por JoséQuintas
Primeira tentativa não deu, pensei errado.

No caso de letras, se não encontrar não aceita.
No caso de números..... isso não existe, pra números tem que ser tratamento diferente de todo restante.

Pra digitar 422

Vai digitar o 4.... e o filtro já vai testar... não serve porque vai anular e não vai deixar digitar mais.

Expandir browse ADO

Enviado: 17 Ago 2020 14:11
por JoséQuintas
Pra esses, acho que vai ter que ser igual o filtro adicional, sem passar pelo filtro enquanto digita.
Pensar mais.
De repente, criar logo um igual o MediaMonkey, quase ilimitado kkkk