Amigos Listeros:

He tomado la excelente idea que leí de la lista días pasados (autoria de
Raúl Martinez Castellanos) y he realizado unos pequeños cambios a la
función publicada para poder realizar 'búsquedas incrmentales', esto es,
que a medida que escribimos, el combo o el list box seleccione
automáticamente lo más cercano a lo buscado. Aquí lo envío para el que le
sirva y felicito a Raúl por su idea.

Las mejoras son:
* funciona tanto para un list como para un combo (que era el que más me
interesaba)
* la tecla backspace permite ir deshaciendo letra a letra lo escrito hasta
volver a la situación incial (en lugar de utilizar el tiempo como lo hacía
la función original).
* su uso se reduce a una sola línea desde los programas

Recomendaciones:
* el combo o el list debe estar sorted=true
* los combos conviene usarlos en style=dropdown list.
El código es VB5. Si usan versiones anteriores, prueben qué pasa.
(la función la llamé 'Incremental Search')


'***************************************************************************
**************************
Public Sub INC_SEARCH(ctrCombo As Control, KeyAscii As Integer)

'variable que guarda string a buscar
Static strSearchString As String

'indice de busqueda
Dim intListItem As Integer

'cantidad de caracteres del string a buscar
Dim intChars As Integer

Dim LngLastPos As Long


If KeyAscii = 8 Then
    'presionaron backspace: borro un caracter
    If strSearchString <> "" Then
        strSearchString = Mid$(strSearchString, 1, Len(strSearchString) - 1)
    End If

    If strSearchString = "" Then
        ctrCombo.ListIndex = -1
        Exit Sub
    End If
Else
    If KeyAscii > 32 Then
        'acumulo las teclas presionadas en la variable estática
        strSearchString = strSearchString & UCase(Chr$(KeyAscii))
    Else
        'no tomo en cuenta teclas especiales
        Exit Sub
    End If
End If


intChars = Len(strSearchString)

With ctrCombo

    LngLastPos = .ListIndex
    For intListItem = 0 To .ListCount - 1
        If UCase(Left(.List(intListItem), intChars)) = strSearchString Then
              LngLastPos = intListItem
              Exit For
        End If

        If .Sorted Then
            If UCase(Left(.List(intListItem), 1)) > strSearchString Then
                intListItem = .ListCount
            End If
        End If
    Next

    If intListItem < .ListCount Then
        .ListIndex = LngLastPos
        KeyAscii = 0
    Else
        strSearchString = ""
    End If

End With

End Sub
'***************************************************************************
**************************


En el evento keypress del combo o la list donde se quiere tener esta
funcionalidad,
debe escribirse una sola línea con :

INC_SEARCH cboPersonas , keyascii

Saludos

------------------------------------
Juan José Martín
martinjj@ssdnet.com.ar
Bs.As. Argentina
------------------------------------

>Hola a todos:
> Alguien me puede decir como puedo mostrar los elementos de
>un ComboBox mientras los estoy escribiendo, de manera que aparezca el ítem
>que mas se parezca a lo que estamos escribiendo.
> Muchas Gracias.
>
Esto lo saque de algun lado (creo que de guille) espero te sirva

1.- Buscar en un ComboBox o ListBox usando el API (1/Mar)

La función que se encarga de esta tarea, como casi siempre, es SendMessage y se deben especificar las siguientes constantes como el mensaje que queremos enviar, según lo que queramos hacer:

Const CB_FINDSTRINGEXACT = &H158 'Buscar cadena completa en un ComboBox
Const LB_FINDSTRINGEXACT = &H1A2 'Buscar cadena completa en un ListBox
Const CB_FINDSTRING = &H14C 'Buscar cadena desde el principio en un ComboBox
Const LB_FINDSTRING = &H18F 'Buscar cadena desde el principio en un ListBox

La declaración de la función SendMessage, debe quedar de esta manera, fijate que el parámetro lParam está definido como Any, de esta forma, aceptará cualquier tipo de dato, Long o ByVal...

#If Win32 Then
    Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, lParam As Any) As Long
#Else
    Private Declare Function SendMessage Lib "User" _
        (ByVal hWnd As Integer, ByVal wMsg As Integer, _
         ByVal wParam As Integer, lParam As Any) As Long
#End If


Este otro ejemplo es para efectuar una búsqueda en el Combo/List, al estilo de la ayuda de Windows, es una versión a la aparecida en los trucos, pero usando SendMessage.
Para usarlo en un ListBox, debes indicar la constante LB_FINDSTRING, en lugar de CB_FINDSTRING (Este "truco" está sacado del MSDN Library: Tip 115: Performing Smart Searches
in Combo Box Controls)

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    Dim CB As Long
    Dim FindString As String
    Const CB_ERR = (-1)
    Const CB_FINDSTRING = &H14C

    If KeyAscii < 32 Or KeyAscii > 127 Then Exit Sub
    If Combo1.SelLength = 0 Then
        FindString = Combo1.Text & Chr$(KeyAscii)
    Else
        FindString = Left$(Combo1.Text, Combo1.SelStart) & Chr$(KeyAscii)
    End If
    CB = SendMessage(Combo1.hWnd, CB_FINDSTRING, -1, ByVal FindString)
    If CB <> CB_ERR Then
        Combo1.ListIndex = CB
        Combo1.SelStart = Len(FindString)
        Combo1.SelLength = Len(Combo1.Text) - Combo1.SelStart
    End If
    KeyAscii = 0
End Sub

   Saludos
*** Lalo ***

Mensaje enviado por "Raul Ornelas" <rornelas@hotmail.com>

Hola a todos

Esto soluciona lo de las busquedas en los combos y no importa que tantos registros tenga primero declaren esto en algun modulo

' para la autobusqueda en los combos
Public Const CB_ERR = -1
Public Const CB_FINDSTRING = &H14C
Public Const CB_FINDSTRINGEXACT = &H158
Public Const CB_GETITEMDATA = &H150
Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lparam As Any) As Long

luego en el modulo hagan esta subrutina:

Public Sub AutoMatch(cbo As ComboBox, KeyAscii As Integer)
Dim sBuffer As String
Dim lRetVal As Long

sBuffer = Left(cbo.Text, cbo.SelStart) & Chr(KeyAscii)
lRetVal = SendMessage((cbo.hWnd), CB_FINDSTRING, -1, ByVal sBuffer)
If lRetVal <> CB_ERR Then
   cbo.ListIndex = lRetVal
   cbo.Text = cbo.List(lRetVal)
   cbo.SelStart = Len(sBuffer)
   cbo.SelLength = Len(cbo.Text)
   KeyAscii = 0
End If
End Sub


por ultimo en el combo con propiedad Style = 0 para que permita escribir, escriben en el evento keypress lo siguiente:

Private Sub Combo2_KeyPress(KeyAscii As Integer)
  AutoMatch Combo2, KeyAscii
End Sub

y Suerte

Saludos

R O