Clipper On Line • Ver Tópico - Expandir browse ADO

Expandir browse ADO

Aqui você poderá oferecer suas Contribuições, Dicas e Tutoriais (Texto ou Vídeo) que sejam de interesse de todos.

Moderador: Moderadores

 

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 12:50

Estou começando a pensar em como acrescentar no "bolo" o filtro por número.
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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 12:58

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
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 13:04

Ao digitar JPA TEC GIA

filtroado.png
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 13:08

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%'
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 13:10

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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 13:27

Errei....
número = "A" , isso não dá
Tem que testar também o que foi digitado.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 13:42

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.
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes

Expandir browse ADO

Mensagempor JoséQuintas » 17 Ago 2020 14:11

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
José M. C. Quintas
Harbour 3.2, mingw, gtwvg, multithread, dbfcdx, ADO+MySql, PNotepad
"The world is full of kings and queens, who blind our eyes and steal our dreams Its Heaven and Hell"

https://github.com/JoseQuintas/
Avatar de usuário

JoséQuintas
Membro Master

Membro Master
 
Mensagens: 18014
Data de registro: 26 Fev 2007 11:59
Cidade/Estado: São Paulo-SP
Curtiu: 15 vezes
Mens.Curtidas: 1206 vezes




Retornar para Contribuições, Dicas e Tutoriais

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 12 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro