Preciso de função pesquisa letra-a-letra com TBROWSE

Projeto [x]Harbour - Compilador de código aberto compatível com o Clipper.

Moderador: Moderadores

Avatar do usuário
janio
Colaborador
Colaborador
Mensagens: 1846
Registrado em: 06 Jul 2004 07:43
Localização: UBAJARA - CE

Preciso de função pesquisa letra-a-letra com TBROWSE

Mensagem por janio »

Bom dia a todos,

Preciso de uma função para pesquisa letra-a-letra com Tbrowse o mais rápido possível.

Obrigado,

Janio
fui...
e-mail:janioaguiar@yahoo.com.br
msn: janio_aguiar@hotmail.com
xHarbour1.2.1/Harbour3.2 + wvg + hwgui + Mediator + MySql
Stanis Luksys
Colaborador
Colaborador
Mensagens: 1329
Registrado em: 18 Jun 2005 03:04
Localização: São Paulo
Contato:

Mensagem por Stanis Luksys »

Ola Janio

Talvez este tópico possa te ajudar...

https://pctoledo.org/forum/viewtopic.php?t=3384

É só dar uma estudada no trecho apresentado pelo colega MARCELOG.


É isso aí...
Stanis Luksys
sites.google.com/hblibs

Apoiar e se utilizar de projetos opensource não é uma questão de boicote, mas sim de liberdade.
Utilize, aprimore e distribua.
MARCELOG
Usuário Nível 4
Usuário Nível 4
Mensagens: 546
Registrado em: 15 Mar 2005 16:54
Localização: Divinópolis/MG

Mensagem por MARCELOG »

Na seção Dowloads do site tem a função em clipper, é só compilar com o xharbour.

MarceloG
Stanis Luksys
Colaborador
Colaborador
Mensagens: 1329
Registrado em: 18 Jun 2005 03:04
Localização: São Paulo
Contato:

Mensagem por Stanis Luksys »

Apenas complementando, a função do toledo não usa TBrowse, e sim dbEdit(), além disso a função é bem limitada, mas serve como base pra estudo e quem sabe se criar uma melhor...
Stanis Luksys
sites.google.com/hblibs

Apoiar e se utilizar de projetos opensource não é uma questão de boicote, mas sim de liberdade.
Utilize, aprimore e distribua.
MARCELOG
Usuário Nível 4
Usuário Nível 4
Mensagens: 546
Registrado em: 15 Mar 2005 16:54
Localização: Divinópolis/MG

Mensagem por MARCELOG »

O arquivo tem o nome de visualiza.zip e o título do link é visualiza dbf.
Esse zip contém o rmk, prg e dbf para utilização imediata do exemplo.
O fonte do prg é este aqui, é só adaptar ao seu caso.

Código: Selecionar todos

# Include "Inkey.ch"
Init Function  Main()
Cls
SetColor("GR+/B")
@ 03,02 Clear To 10,65
@ 03,02 To 10,65
//-----------      1         2         3         4         5         6         7
//-----------4567890123456789012345678901234567890123456789012345678901234567890123456
@ 03,03 Say "| Cadastro de Produtos |"
@ 05,04 Say "     Codigo: _____                                   "
@ 06,04 Say "  Descricao: ________________________________________"
@ 07,04 Say "Preco Unit.: _.___,__                                "
@ 08,04 Say " Quantidade: ___.___,___                             "
@ 10,05 Say "[ESC]-Sair  [F3]-Consulta"
TelaPrincipal:=SaveScreen(0,0,24,79)

SetKey(K_F3,{||Pega(ReadVar())})

Do While .T.
   RestScreen(0,0,24,79,TelaPrincipal)
   SetCursor(1)
   SetColor("W+/U,W+/BG,,Gr+/B,W+/U")
   M->Pro_Codigo:=Space(05)
   @ 05,17 Get M->Pro_Codigo Pict "99999"
   Read

   If LastKey() = K_ESC
      Exit
   EndIf

   M->Pro_Codigo:=StrZero(Val(M->Pro_Codigo),5)

   Use Produto Index Codigo,Descri Alias Pro New
   If DbSeek(M->Pro_Codigo)
      M->Pro_Descri:=Pro->Pro_Descri
      M->Pro_PreUni:=Pro->Pro_PreUni
      M->Pro_Quanti:=Pro->Pro_Quanti
      DbCloseArea()
      SetColor("W+/B")
      @ 06,17 Say M->Pro_Descri
      @ 07,17 Say M->Pro_PreUni Pict "@E 9,999.99"
      @ 08,17 Say M->Pro_Quanti Pict "@E 999,999.999"
      @ 11,02 Say "Tecle Enter para Continuar..."
      SetCursor(0)
      Inkey(0)
      SetCursor(1)
   Else
      DbCloseArea()
      Alert("Produto NÆo Cadastrado!")
   EndIf

EndDo
SetColor("")
Cls
Return

Static Function Pega(Var)
Local Regra:="Pro_Quanti = 0"
SetKey(K_F3,.F.)
If LastKey() = K_F3
   If Upper(Var) = "M->PRO_CODIGO"
      M->Pro_Codigo:=Consulta(04,14,18,66,"Produto","Descri.Ntx,Codigo.Ntx",;
                          {"Pro_Codigo","Pro_Descri","Pro_Quanti"},{"C¢digo","Descri‡Æo","Quantidade"},;
                          {"99999","@!","@E 999,999.999"},Regra)
   EndIf

EndIf
SetKey(K_F3,{||Pega(ReadVar())})
Return


Function Consulta(Li,Ci,Lf,Cf,Arquivo,Indices,Campo,Cabecalho,Pict,Regra)

/* Parametros
Li, Ci    - Coordenadas do canto superior esquerdo da janela de visualiza‡Æo
Lf, Cf    - Coordenadas do canto inferior direito da janela de visaliza‡Æo
Arquivo   - Arquivo a ser visualizadp
Indices   - Indices do arquivo
Campo     - Matriz que contem os campos do arquivo a serem  visualizados
Cabecalho - Matriz que contem o cabecalho das colunas a serem visualizados
Pict      - Matriz com as pictures dos campos. Este paramentro ‚ opcional
Regra     - String com a valida‡Æo dos campos. Este parametro ‚ opcional
*/

Local Tela:=SaveScreen(0,0,24,79),Area:=Select(), CorSalva:=SetColor()
Local oMyBrowser, Coluna, nKey, NroDig:=0, Nome:="", Col:=Ci+14

Use (Arquivo) Index (Indices) New  // Troque esta linha pela fun‡Æo que vc utiliza
DbGotop()                          // para abrir seus arquivos em rede

SetColor("U/W")
@ Li,Ci Clear To Lf,Cf
@ Li,Ci To Lf,Cf
@ Li+2,Ci Clear To Lf,Cf
@ Li+2,Ci To Lf,Cf
@ Li+2,Ci Say Chr(195)
@ Li+2,Cf Say Chr(180)
@ Li+4,Ci Say Chr(195)
@ Li+4,Cf Say Chr(180)
@ Li+1,Ci+3 Say "Pesquisar: _________________________"
SetCursor(0)

X:=Campo[2]
oMybrowser:=TBrowseDb(Li+3,Ci+1,Lf-1,Cf-1)
oMybrowser:HeadSep  :=Chr(196) + Chr(196) + CHr(196)
oMybrowser:ColSep   :=Space(01) + Chr(179) + Space(01)
oMybrowser:ColorSpec:="U/W,W+/BG,R/W,R/BG"

For I:=1 To Len(Campo)

    Coluna:=TbColumnNew(Cabecalho[I],FieldwBlock(Campo[I],Select()))
    Coluna:Picture:=Pict[I]
    If Regra # Nil
       Coluna:ColorBlock:={|X| If(&(Regra),{3,4},{1,2})}
    EndIf
    oMybrowser:AddColumn(Coluna)

Next

Do While .T.

   Do While ( ! oMyBrowser:Stabilize() )

      nKey:=InKey()

      If nKey != 0
         Exit
      EndIf

   EndDo

   If oMyBrowser:Stable

      If oMyBrowser:HitTop
         @ Lf,Cf-12 Say "| Inicio |"
      ElseIf oMyBrowser:HitBottom()
         @ Lf,Cf-12 Say "|  Fim   |"
      Else
         @ Lf,Cf-12 Say "ÄÄÄÄÄÄÄÄÄÄ"
      EndIf

      nKey:=Inkey(0)
   EndIf

   If nKey == K_ESC
      DbCloseArea()
      Exit
   ElseIf nKey == K_UP
      oMyBrowser:Up()
   ElseIf nKey == K_DOWN
      oMyBrowser:Down()
   ElseIf nKey == K_LEFT
      oMyBrowser:Left()
   ElseIf nKey == K_RIGHT
      oMyBrowser:Right()
   ElseIf nKey == K_HOME
      oMyBrowser:Home()
   ElseIf nKey == K_END
      oMyBrowser:End()
   ElseIf nKey == K_PGUP
      oMyBrowser:PageUp()
   ElseIf nKey == K_PGDN
      oMyBrowser:PageDown()
   ElseIf nKey == K_CTRL_PGUP
      oMyBrowser:GoTop()
   ElseIf nKey == K_CTRL_PGDN
      oMyBrowser:GoBottom()
   ElseIf nKey == K_CTRL_HOME
      oMyBrowser:PanHome()
   ElseIf nKey == K_CTRL_END
      oMyBrowser:PanEnd()
   ElseIf nKey == K_CTRL_LEFT
      oMyBrowser:PanLeft()
   ElseIf nKey == K_CTRL_RIGHT
      oMyBrowser:PanRight()
   ElseIf nKey == K_ENTER
      Var:=&(Campo[1])
      DbCloseArea()
      Sele(Area)
      RestScreen(0,0,24,79,Tela)
      SetColor(CorSalva)
      SetCurSor(1)
      Return(Var)
   Else

[color=red]//Esse trecho do código faz o que você quer[/color]

      wDigito:=LastKey()
      If wDigito  = 8
         If NroDig = 0
            Loop
         EndIf
         Col--
         NroDig--
         @ 05,Col Say "_"
         Nome:=Subs(Nome,1,Len(Nome)-1)
         If Empty(Nome)
           oMyBrowser:GoTop()
           Loop
         EndIf
         DbSeek(Upper(Nome),.T.)
         oMyBrowser:RefreshAll()
         Loop
      EndIf
      If NroDig = 25
         Col:=Ci+38
         NroDig--
         Nome:=Subs(Nome,1,Len(Nome)-1)
      EndIf
      Nome:= Nome+Chr(wDigito)
      @ 05,Col Say Upper(Chr(wDigito))
      Col++
      NroDig++
      DbSeek(Upper(Nome),.T.)
      oMyBrowser:RefreshAll()
   EndIf

EndDo
DbCloseArea()
Sele(Area)
RestScreen(0,0,24,79,Tela)
SetColor(CorSalva)
SetCurSor(1)
Return
Espero ter ajudado (como muitos me ajudaram).

MarceloG

DICA: com tbrowse é bom ir devagar, comece com coisas pequenas e absorva o conceito da classe. Mude parâmetros, veja o que acontece.
Na instalação do clipper tem vários exemplos, compile os mesmos e verique os recursos. É possível fazer coisas incríveis.
Editado pela última vez por Itamar M. Lins Jr. em 25 Jul 2022 08:21, em um total de 1 vez.
Razão: Mensagem editada para colocar a tag [ code ]<br>Veja como utilizar esta tag: http://www.pctoledo.com.br/forum/faq.php?mode=bbcode#f2r1
Responder