Búsqueda en browse con simbolicos raros

[informaticaeloy]

Hola. Tengo un problema que no se como solucionar. Tengo un listbox con registros de la base de datos. En la parte superior del mismo, tengo un say, que muestra el valor de una variable, y un get para introducir texto. La idea es no poder interactuar con el listbox y que conforme vas escribiendo texto, busco en el listbox y se va actualizando la búsqueda. Es un poco lioso pero es la única forma que encontré para que también se actualice la busque al pulsar la tecla borrar y las flechas.

Este es el codigo del listbox:

Code: Select all  Expand view

        @09, 10  GET BUFFER PIXEL SIZE  160,12;
         COLOR "B/W" OF B_CLI_V READONLY

         @10, 15  SAY BUFFER PIXEL SIZE  150,10;
         COLOR "B/W" OF B_CLI_V UPDATE

         @ 2, 1 LISTBOX LIS_CLI FIELDS CODIGO,NOMBRE;
                HEADERS  "Código","Nombre";
                FIELDSIZES  50,150;
                UPDATE;
                SIZE 300, 150 OF B_CLI_V;
                COLOR "N/W";
                ON CHANGE BUS_C(46,LIS_CLI)

         LIS_CLI:BKEYDOWN:={|nkey,nflags|BUS_C(NKEY,LIS_CLI)}

y esta la función de búsqueda:

Code: Select all  Expand view

FUNCTION BUS_C(NKEY,LIS_CLI)

         local teclado
         //msgalert(nkey)
         TECLADO:={{190,"."},;
                   {110,"."},;
                   {107,"+"},;
                   {111,"/"},;
                   {106,"*"},;
                   {188,","},;
                   {189,"-"},;
                   {109,"-"},;
                   { 32," "},;
                   { 96,"0"},;
                   { 97,"1"},;
                   { 98,"2"},;
                   { 99,"3"},;
                   {100,"4"},;
                   {101,"5"},;
                   {102,"6"},;
                   {103,"7"},;
                   {104,"8"},;
                   {105,"9"},;
                   {220,"§"},;
                   {221,"¦"},; /// esto ya es a la desesperada
                   {219,"█"},; /// esto ya es a la desesperada  
                   {192,"¥"}}

         DO CASE
            CASE NKEY=46
                 BUFFER=SPACE(0)
                 LIS_CLI:REFRESH()
                 B_CLI_V:UPDATE()
                 RETURN .T.
            CASE NKEY=8
                 IF .NOT. EMPTY(BUFFER)
                    BUFFER=LEFT(BUFFER,LEN(BUFFER)-1)
                 ENDIF
            CASE NKEY=13
                 B_CLI_V:END()
                 CABALB[4]=CODIGO
                 CABALB[5]=NOMBRE
                 IF !EMPTY(NOMBRECOM)
                    aDATOS_CLI[1]=NOMBRECOM
                 ELSE
                    aDATOS_CLI[1]=NOMBRE
                 ENDIF
                 CABALB[5]=aDATOS_CLI[1]

                 aDATOS_CLI[2]=DIRECCION
                 aDATOS_CLI[3]=POBLACION
                 aDATOS_CLI[4]=PROVINCIA
                 RETURN .T.
            CASE NKEY=27
                 B_CLI_V:END()
                 CABALB[4]=SPACE(5)
                 RETURN .T.
            CASE NKEY>=48 .AND. NKEY<=57
                 BUFFER+=CHR(NKEY)
            CASE NKEY>=65 .AND. NKEY<=90
                 BUFFER+=CHR(NKEY)
            OTHERWISE
                 FOR N=1 TO LEN(TECLADO)
                     IF TECLADO[N,1]=NKEY
                        BUFFER+=OEMTOANSI(TECLADO[N,2])
                     ENDIF
                 NEXT
         ENDCASE
         IF ISALPHA(BUFFER)
            DBSETORDER(2)
            BUSCA=BUFFER
            SET SOFTSEEK ON
            SEEK BUSCA
            SET SOFTSEEK OFF
            if !found()
               DBSETORDER(3)
               SET SOFTSEEK ON
               SEEK BUSCA
               SET SOFTSEEK OFF
               if !found()
                  DBSETORDER(2)
               endif
            endif
         ELSE
            DBSETORDER(1)
            BUSCA=CEROS(5,BUFFER)
            SET SOFTSEEK ON
            SEEK BUSCA
            SET SOFTSEEK OFF
         ENDIF

         LIS_CLI:REFRESH()
         B_CLI_V:UPDATE()
RETURN .T.
 

Con letras y números funciona perfectamente, pero tengo problemas con los textos de º , ª, €, @, ...

No se como hacerlo, y hay un cliente que me ha metido ya miles de clientes y muchos de ellos son mª josé.... mª carmen.... y claro, el listbox no busca. Por favor ¿alguna sugerencia? gracias.

[cmsoft]

Y si usas xBrowse?
Te hace la busqueda incremental sola...

Code: Select all  Expand view

#include 'fivewin.ch'
#include 'ord.ch'
#include 'xbrowse.ch'
#include 'hbcompat.ch'

REQUEST DBFCDX

//----------------------------------------------------------------------------//

function Main()

   local oDlg, oBrw

   RDDSETDEFAULT( "DBFCDX" )
   USE CUSTOMER
   SET ORDER TO TAG FIRST
   GO TOP

   DEFINE DIALOG oDlg SIZE 600,400 PIXEL

   @ 30,10 XBROWSE oBrw SIZE -10,-10 PIXEL OF oDlg ;
      COLUMNS "CODIGO","NOMBRE" HEADERS "Código","Nombre" AUTOSORT ALIAS "CUSTOMER" CELL LINES NOBORDER

   oBrw:lIncrFilter  := .t.
   oBrw:lSeekWild    := .t.

   @ 10,10 SAY oBrw:oSeek PROMPT oBrw:cSeek SIZE 100,10 PIXEL ;
      OF oDlg COLOR CLR_BLACK,CLR_YELLOW PICTURE '@!' // Aca muestras lo que se escribe por teclado, que lo va guardando el mismo browse


   oBrw:CreateFromCode()

   ACTIVATE DIALOG oDlg CENTERED

return nil

//----------------------------------------------------------------------------//
 

Espero que te de una pista al menos. Pero el xBrowse, en lugar del ListBox, es una buena alternativa

[MarioG]

Alguien dijo por ahí... "para que re inventar la rueda" (Eloy no lo tomes a mal es una borma para ponerle "color" al post).
Comparto la propuesta de CM...
No obstante haya por el 2002 desarrollamos algo con Daniel Andrade (un clipero arg). que lo sigo usando en aplicaciones que todavía quedan con wBrowse

Code: Select all  Expand view

/*
 *  TSekInc.prg
 *
 *  Clase para Busquedas Incrementales en Browsers
 *  FiveWin(tm)
 *
 *  Creada por Andrade Daniel [03/01/2002]
 *  Basado en SeekInc() del Ing. Mario González
 *
 *  Libre Distribuci¢n
 *
 *  Andrade Daniel [2002]
 *  andrade_2knews@hotmail.com
 *  Rosario, SF, Argentina
 *  ***************************

    //-----------------------
    Versión 2.3 - 21/10/2003
    Agregado: Reasignacion 3er param. de aOrders,
              Búsqueda por Clave compuesta,
              Salida en Barra de Mensajes de Wiwndows

    por: eMeGe (Ing. Mario González)
    mgonzalez@ing.unne.edu.ar

    1. Se reasigna uso de tercer parámetro de array
       aOrders := {{"FIRST","NOMBRE",.T.}, {"LAST","APELLIDO",.T.}, {"STREET","DIRECCION",.F.}, {"CITY","LOCALIDAD",.F.}}
       De esta forma al estar activo lFullSeek, las búsquedas se hacen, optativamente por ej. para Nombre y Apellido

    2. Se agrega la DATA cClaveAdic; lo que permite búsqueda por claves compuestas.
       La DATA cClaveAdic es "" por defecto.
       Se puede probar en Test.prg creando un índice compuesto para Test.dbf con los campos
       STATE+LAST, luego realizar un Browse estableciendo un Scope para STATE.
       Finalmente el código de búsqueda podría ser:

       oSeek:= TSeekInc():New( oBrw, oDbf, oBuff, oSayOrd, aOrders, TRUE)
       oBrw:bKeyChar := {|nK| if( nK==VK_RETURN, nil, ( oSeek:cClaveAdic:= field->STATE, ;       <--- Asigno Clave Adic.
                                                        cBusca:= oSeek]:Seek( nK, TRUE ) ) }

       Con el Browse activo; solo se ingresa la búsqueda por LAST

    3. Se agrega posibilidad visualizar texto de búsqueda en Barra de Mensajes en Windows
       (Tomado de samples de Hernán Checarelli)

       @3000,0 say oBuff var cBusca of oWnd1                               // Con esto el texto queda fuera de pantalla

       oSeek:= TSeekInc():New( oBrw, oDbf, oBuff,, aOrders, TRUE)          // oSayOrder es nil

       oBrw:bKeyChar := {|nK| if( nK==VK_RETURN, nil, ( oSeek:cClaveAdic:= field->STATE , ;       <--- Asigno Clave Adic.
                                                        cBusca:= oSeek]:Seek( nK, TRUE ), ;
                                                        oSeek:UpMsgBarBuffer( oWnd:oMsgBar, cBusca, CLR_HBLUE ) ) ) }


    //-----------------------
    Versión 2.00 - 17/06/2003
    Agregado: Búsqueda por campos índices, existentes, predefinidos
    por: eMeGe (Ing. Mario González)
    mgonzalez@ing.unne.edu.ar

    Se agrega un checkbox para que busque por todos los campos índices existentes
    lFullSeek se puede pasar nil si no se desea utilizar
    xOrderName puede ser de tipo Caracter (orden de búsqueda) o Array.
    Puede ser nil, entonces la búsqueda será por el Orden Actual
    Si es Array, debe ser multiarray y cada subarray deberá tener 3 items
    (ver Test.prg Lin 185)
    1.- Nombre del Orden      (C)
    2.- Descripción del Orden (C)
    3.- (L) Verdadero = Orden activo en la búsqueda            // re asignado 21/10/03

    Al buscar, si ::lFullSeek y ::lCellStyle, estan activos el puntero se posiciona
    en la última celda/columna encontrada
 */

# include "FiveWin.ch"
#define _KEYTAG    1
#define _TXTTAG    2
#define _STATUSTAG 3          // Para busquedas textuales activa CASE SENSITIVE


/*
 *  Clase TSeekInc()
 */
CLASS TSeekInc

  DATA    oDbf                  AS OBJECT    INIT NIL    // Objeto TDBF, TDataBase
  DATA    oBrw                  AS OBJECT    INIT NIL    // Objeto TwBrowse, TsBrowse, TcBrowse
  DATA    oTextSeek             AS OBJECT    INIT NIL    // Objeto SAY para Texto de Busqueda
  DATA    oSayOrder             AS OBJECT    INIT NIL    // Objeto SAY para Nombre del Orden

  DATA    aOrderBag             AS ARRAY        INIT {}  // Contenedor de Ordenes             - Agregado por eMeGe 12/06/03
  DATA    nOrder                AS NUMERIC      INIT 0   // Posición del Orden por defecto    - Agregado por eMeGe 12/06/03
  DATA    cOrderName            AS CHARACTER    INIT ""  // Nombre del Orden Activo
  DATA    cBuffer               AS CHARACTER    INIT ""  // Buffer de Busqueda
  DATA    cClaveAdic            AS CHARACTER    INIT ""  // Clave, de Busqueda, Adicional     - Agregado por eMeGe 21/10/03
  DATA    nLastKey              AS NUMERIC      INIT 0   // Ultima Tecla Pulsada
  DATA    lFullSeek             AS LOGIC                 // Busca por Todos los Campos        - Agregado por eMeGe 12/06/03

  // Metodo Contructor
  METHOD  New( oBrw, oDbf, oTextSeek, oSayOrder, xOrderName, lFullSeek )  CONSTRUCTOR

  // Metodo de Busqueda en bKeyChar()
  METHOD  Seek( nKey, lUpper )

  // Metodo para Cambio de Orden
  METHOD  ChangeOrder( nNewOrder, cOrderName )

  // Metodo para mostrar texto en Barra de Mensajes
  METHOD  UpBuffMsgBar( oMsgBar, cBusca, cClrTxt )                                    // - Agregado por eMeGe 21/10/03

ENDCLASS

/*
 *  New()
 */
METHOD New( oBrw, oDbf, oTextSeek, oSayOrder, xOrderName, lFullSeek ) CLASS TSeekInc

  DEFAULT lFullSeek:= .f.

  ::oBrw        := oBrw
  ::oDbf        := oDbf
  ::oTextSeek   := oTextSeek
  ::oSayOrder   := oSayOrder
  ::lFullSeek   := lFullSeek

  if Valtype( xOrderName ) == "C" .or. Empty( xOrderName )                                // Agregado por eMeGe 12/06/03
     ::cOrderName := if( Empty( xOrderName ), OrdSetFocus(), xOrderName )
  elseif Valtype( xOrderName ) == "A"
     ::aOrderBag := xOrderName
     if (::nOrder:= aScan( ::aOrderBag, {|arr| arr[_KEYTAG]==OrdName() }) ) == 0          // Modificado por eMeGe 21/10/03
        ::nOrder:= 1
     end
     ::cOrderName := ::aOrderBag[::nOrder,_KEYTAG]
  end

  if ::oSayOrder != NIL
    ::oSayOrder:SetText( if( ::nOrder==0, ::cOrderName, ::aOrderBag[::nOrder,_TXTTAG] ) )
  endif
  DbSetOrder( ::cOrderName )

RETURN Self

/*
 *  Seek()
 */
METHOD Seek( nKey, lUpper ) CLASS TSeekInc

  local lOk     := .F.
  local cSeek   := ::cBuffer
  local nRecNo  := ::oDbf:RecNo()
  local nX, nOrdAct
  local nOrdCount
  local cKey

  DEFAULT lUpper  := .F.



  if (nKey == NIL)

  else
    if ((nKey == VK_BACK) .and. ::nLastKey == VK_CONTROL)   .or. ;
        ((nKey == VK_DELETE) .and. GetKeyState(VK_CONTROL)) .or. ;
        ((nKey == 127) .and. GetKeyState(VK_CONTROL))

      ::cBuffer := ""

    elseif (nKey == VK_BACK)
      lOk   := .T.
      cSeek := Left( cSeek, Len(cSeek) - 1 )

    else  //if nKey != 16 // SHIFT
      lOk   := .T.
      cKey  := iif( lUpper, Upper(Chr(nKey)), Chr(nKey))

      if Empty( cSeek ) .or. Len( cSeek ) == Len( ::cClaveAdic )                       // Agregado por eMeGe 21/10/03
         cSeek:= ::cClaveAdic
      end
      cSeek += cKey

    endif

    if !Empty( ::aOrderBag ) .and. ::lFullSeek                                         // Agregado por eMeGe 12/06/03

       nOrdAct  := ::nOrder
       nOrdCount:= 1

       while .t.
         if !( ::oDbf:Seek( cSeek ) )
            if !( ::oDbf:Seek( cSeek, .T. ) )
               ++nOrdCount
               ++nOrdAct
               if nOrdAct > Len( ::aOrderBag )
                  nOrdAct:= aScan( ::aOrderBag, {|a| a[3]==.T.} )                      // Modificado por eMeGe 21/10/03
               else
                  if !::aOrderBag[nOrdAct,_STATUSTAG]                                  // Agregado por eMeGe 21/10/03
                     loop
                  end
               end
               ::nOrder:= nOrdAct

               DbSetOrder( ::aOrderBag[nOrdAct,_KEYTAG] )                              // Modificado por eMeGe 21/10/03

               if nOrdCount > Len( ::aOrderBag )
                  // DbSetOrder( ::aOrderBag[1,_KEYTAG] )                              // Agregdo por eMeGe 21/10/03
                  lOk= .f.
                  exit
               end
               if ::oSayOrder != NIL
                  ::oSayOrder:SetText( ::aOrderBag[nOrdAct,_TXTTAG] )
               end
            end
         else
            ::oBrw:nColAct:= ::nOrder
            exit
         end
       enddo

    else

       if !(::oDbf:Seek(cSeek))
         if !(::oDbf:Seek(cSeek, .T.))
           lOk := .F.
         endif
       endif

    endif
  endif

  if lOk
    ::cBuffer:= cSeek
    if !Empty( ::cClaveAdic )                                                          // Agregado por eMeGe 21/10/03
       ::oTextSeek:SetText( SubStr( ::cBuffer, Len(::cClaveAdic)+1 ) )
    else
      ::oTextSeek:SetText( ::cBuffer )
    end

    if ::oBrw:ClassName()=="TWBROWSE"
      ::oBrw:nRowPos:= Max( Min( ::oBrw:nLen, ::oBrw:nRowCount ), 1 )
      ::oBrw:Refresh()
    else
      ::oBrw:UpStable()
      ::oBrw:Refresh(.F.)
    endif

  else

    if GetKeyState(VK_CONTROL)                                                         // Agregado por eMeGe 21/10/03
    elseif nKey == VK_BACK                                                             // Agregado por eMeGe 18/17/06
    elseif ( (nKey == 127) .and. GetKeyState(VK_CONTROL) )
    else
      Tone(750)
      Tone(700)
    end

    if !Empty( ::cClaveAdic )                                                          // Agregado por eMeGe 21/10/03
       ::oTextSeek:SetText( SubStr( ::cBuffer, Len(::cClaveAdic)+1 ) )
    else
      ::oTextSeek:SetText( ::cBuffer )
    end
    ::oDbf:GoTo( nRecNo )
    ::oBrw:Refresh()

  endif

  if ::oSayOrder != NIL
    ::oSayOrder:SetText( if( ::nOrder==0, ::cOrderName, ::aOrderBag[::nOrder,_TXTTAG] ) )    // Agregado por eMeGe 12/06/03
  endif

  ::nLastKey  := nKey

RETURN ::cBuffer

/*
 *  ChangeOrder()
 */
METHOD ChangeOrder( cOrderName ) CLASS TSeekInc

  DEFAULT cOrderName := OrdSetFocus()

  ::cOrderName  := cOrderName
  ::cBuffer     := ""

  if ::oSayOrder != NIL
    ::oSayOrder:SetText( ::cOrderName )
  endif

  ::oTextSeek:SetText( ::cBuffer )

  if ::oBrw:ClassName()=="TWBROWSE"
    ::oBrw:Refresh()
  else
    ::oBrw:Refresh(.F.)
  endif

RETURN Self

// ------------------------------------------------------------------ \\
//   MsgBar de búsqueda
//   (c) by ChecaNet
METHOD UpBuffMsgBar( oMsgBar, cBuffer, nClrBackFocus ) CLASS TSeekInc
local nClrText:= oMsgBar:nClrText
local cMsg

   DEFAULT nClrBackfocus:= CLR_BLACK

   if Len( cBuffer ) > 0
      cMsg:= "Buscando: " + cBuffer
      oMsgBar:nClrText:= nClrBackFocus
   else
      cMsg:= oMsgBar:cMsgDef
   endif
   oMsgBar:SetMsg( PadR( cMsg,200 ) )
   oMsgBar:nClrText:= nClrText

   return( nil )
// Fin
 

[informaticaeloy]

Hola chicos, perdonad la tardanza, no he tenido tiempo de sentarme a probar lo que me habéis sugerido. Al final he probado el ejemplo de cmsoft. Me está costando mucho hacer el cambio, pues la generación del listbox lo tenía dentro de un superanidamiento de if else if else if else if ...... hasta el infinito y más allá!!! para mostrar distintos tipos de listbox según la configuración personal de cada cliente, si lo quieren ordenador por fecha, por cliente, por importe, ... según el tipo de licencia que han comprado del programa, según el tipo de columnas que quiero que aparezcan ... pero bueno, lo tengo ya casi listo y hace lo que necesito y mil cosas más. Además el aspecto es mucho más moderno. Gracias. Si me sale alguna cosa nueva con el xbrowse os preguntaré. Un saludo.

[MarioG]

Acá estamos... desde siempre