Solved

Key press

Posted on 2001-09-04
17
504 Views
Last Modified: 2011-05-13
I am using VB6 and access
I would like to know how to:

In a combo box when I am searching for a specific field. If I type the letter H for example, I would like the closest match to appear after I hit the letter H.
Example if I have words like hello, help, hold, peter, michael etc..... in the database.
If I press the combo box all these names will appear in the drop down box, if I type the letter M, then Michael will appear. Or if I press H, then hello will appear, instead of typing out the whole word, it brings back the closest match.
Also in what event should this code in put into?
In the keypress event?

Thanks very much.

0
Comment
Question by:mscala
  • 5
  • 4
  • 2
  • +6
17 Comments
 
LVL 3

Expert Comment

by:Maxim10553
Comment Utility
i have an example i created very similar to what you want but it uses a textbox instead of a comboxbox. also you want to change the dbcode syntax a little to make it specific to your needs. here ya go

Option Explicit
Dim cn As New ADODB.Connection
Dim Key As Long

Private Sub Form_Load()

cn.Open ("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=C:\Temp\db1.mdb")

End Sub

Private Sub Text1_Change()

'dont go at database is backspace is hit
If Key = 8 Then Exit Sub

Dim grabbedtext As String: Dim sql As String
Dim rs As New ADODB.Recordset

grabbedtext = Text1.Text
If grabbedtext = "" Then Exit Sub

sql = "Select term from temp where term like '" & grabbedtext & "%'"

Set rs = cn.Execute(sql)

If rs.EOF = False Then
    Text1.Text = rs("Term")
    Text1.SelStart = Len(grabbedtext)
    Text1.SelLength = Len(Text1.Text)
Else
End If

rs.Close
Set rs = Nothing

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Key = KeyAscii
End Sub
0
 
LVL 4

Accepted Solution

by:
wileecoy earned 100 total points
Comment Utility
Try this - I modified some code for Underground Browser that I got from PlanetSourceCode.com.

I have a standard form (form1) and one combobox (combo1) and a module (module1).


The following goes in the form - it is followed by the code that goes in the module.

******** begin code Form1

Option Explicit

Private Const CB_ERR = (-1)
Private bBackSpace As Boolean
Private Const CB_FINDSTRING = &H14C

Private Sub Combo1_KeyPress(KeyAscii As Integer)
   
    'Check for backspace key
    If KeyAscii = 8 Then
        bBackSpace = True
    Else
        bBackSpace = False
    End If
   
    If KeyAscii = vbKeyReturn Then
        'Do whatever you want when one is selected.
    End If

End Sub

Private Sub Form_Load()
Combo1.AddItem "Alfred"
Combo1.AddItem "Andrew"
Combo1.AddItem "Bart"
Combo1.AddItem "Benjamin"
Combo1.AddItem "Harry"
Combo1.AddItem "Michael"
Combo1.AddItem "Norman"
Combo1.AddItem "Oscar"
Combo1.AddItem "Randy"
Combo1.AddItem "Steven"
Combo1.AddItem "Troy"
Combo1.AddItem "Victor"
Combo1.AddItem "William"

End Sub

Private Sub combo1_Change()
    'This will cause an Auto Complte Effect
    On Error GoTo combo1_Change_Error:
    Dim i As Long, j As Long, Pos As Integer
    Dim strPartial As String, strTotal As String
   
    If Not bBackSpace Then
        With Combo1
            strPartial = .Text
            i = SendMessage(.hWnd, CB_FINDSTRING, -1, ByVal strPartial)
           
            If i <> CB_ERR Then
                strTotal = .List(i)
                j = Len(strTotal) - Len(strPartial)
               
                If j <> 0 Then
                    .SelText = Right$(strTotal, j)
                    .SelStart = Len(strPartial)
                    .SelLength = j
                Else
                End If
            Else
            End If
           
        End With
    End If
    Exit Sub
   
combo1_Change_Error:
     MsgBox Err.Number & ", " & Err.Description, vbOKOnly
   
End Sub

******** end code Form1

Now the module:

******** begin code Module1

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                            (ByVal hWnd As Long, _
                            ByVal wMsg As Long, _
                            ByVal wParam As Long, _
                            lParam As Any) As Long  

******** end code Module1


hth.

wileecoy.
0
 
LVL 4

Expert Comment

by:wileecoy
Comment Utility
oh btw - once you add the above, all you have to do is press F5 and begin typing the names in the combobox.

Thanks - Wileecoy
0
 
LVL 4

Expert Comment

by:VincentLawlor
Comment Utility
Here is a nice Example
Heres a simple class to do this type of thing.

Create a new class called clsBoxSearch

Add the following code to the class


Private Const LB_FINDSTRING As Long = &H18F
Private Const CB_ERR As Long = (-1)
Private Const LB_ERR As Long = (-1)
Private Const CB_FINDSTRING As Long = &H14C
Private Const CB_SHOWDROPDOWN As Long = &H14F

Private Declare Function SendMessageStr Lib _
    "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     ByVal lParam As String) As Long
   
Public Sub FindIndexStr(ctlSource As Control, _
   ByVal str As String, intKey As Integer, _
   Optional ctlTarget As Variant, Optional ctlOutput As Variant)
Dim lngIdx As Long
Dim FindString As String

If (intKey < 32 Or intKey > 127) And _
   (Not (intKey = 13 Or intKey = 8)) Then Exit Sub

If Not intKey = 13 Or intKey = 8 Then
    If Len(ctlSource.Text) = 0 Then
        FindString = str & Chr$(intKey)
    Else
        FindString = Left$(str, ctlSource.SelStart) & Chr$(intKey)
    End If
End If

If intKey = 8 Then
   If Len(ctlSource.Text) = 0 Then Exit Sub
   Dim numChars As Integer
   numChars = ctlSource.SelStart - 1
   'FindString = Left(str, numChars)
   If numChars > 0 Then FindString = Left(str, numChars)
End If

If IsMissing(ctlTarget) And TypeName(ctlSource) = "ComboBox" Then
    Set ctlTarget = ctlSource
        If intKey = 13 Then
          Call SendMessageStr(ctlTarget.hWnd, _
             CB_SHOWDROPDOWN, True, 0&)
          Exit Sub
        End If
    lngIdx = SendMessageStr(ctlTarget.hWnd, _
       CB_FINDSTRING, -1, FindString)
ElseIf TypeName(ctlTarget) = "ListBox" Then
    ctlOutput.Clear
    If intKey = 13 Then Exit Sub
    lngIdx = SendMessageStr(ctlTarget.hWnd, _
           LB_FINDSTRING, -1, FindString)
    Dim i As Integer
    i = -1
    If lngIdx <> -1 Then
        i = lngIdx
        Do
            ctlOutput.AddItem ctlTarget.List(i)
            i = SendMessageStr(ctlTarget.hWnd, _
               LB_FINDSTRING, i, FindString)
        Loop While i > lngIdx
    End If
Else
    Exit Sub
End If
 
If lngIdx <> -1 Then
        ctlTarget.ListIndex = lngIdx
        If TypeName(ctlSource) = "TextBox" Then ctlSource.Text = ctlTarget.List(lngIdx)
        ctlSource.SelStart = Len(FindString)
        ctlSource.SelLength = Len(ctlSource.Text) - ctlSource.SelStart
End If
intKey = 0

End Sub

Now add the following to a form

A combobox called cboFonts
Two listboxes call them lstFonts and lstOutput
A text box called txtFillbox

Add the following to the genral declarations of your form

Option Explicit

Dim cBox As New clsBoxSearch

Private Sub cboFonts_KeyPress(KeyAscii As Integer)
    cBox.FindIndexStr cboFonts, cboFonts.Text, KeyAscii
End Sub

Private Sub Form_Load()
   Dim i As Integer
   Dim max As Integer
   max = Screen.FontCount
   If max > 35 Then max = 35
   For i = 1 To max
      lstFonts.AddItem Screen.Fonts(i)
      cboFonts.AddItem Screen.Fonts(i)
      Next i
End Sub

Private Sub txtFillBox_KeyPress(KeyAscii As Integer)
   cBox.FindIndexStr txtFillBox, txtFillBox.Text, _
     KeyAscii, lstFonts, lstOutput
End Sub

Hope this example helps.

Vin.

0
 
LVL 5

Expert Comment

by:rkot2000
Comment Utility
i am using simular solution :


Option Explicit

Private Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Const CB_FINDSTRING As Long = &H14C
Private Const CB_FINDSTRINGEXACT As Long = &H158


Private Sub Combo1_KeyPress(KeyAscii As Integer)
  Select Case KeyAscii
    Case vbKeyBack
   
    Case Is >= 32
      'perform auto search
     
      If Combo1.SelLength > 0 Then
        Combo1.SelText = VBA.Chr$(KeyAscii)
      Else
        Combo1.Text = Combo1.Text & VBA.Chr$(KeyAscii)
      End If
      KeyAscii = 0
      Call TypeAheadCombo(Combo1)
  End Select
 
End Sub

Private Sub Form_Load()
  Combo1.Clear
  Combo1.AddItem "one"
  Combo1.AddItem "two"
  Combo1.AddItem "other"
  Combo1.AddItem "new"
 
End Sub

Public Sub TypeAheadCombo(ljCombo As ComboBox)
  Dim lviIndex As Integer
  Dim lvsKeyString As String
  Dim lviKeyLen As Integer
 
  lvsKeyString = ljCombo.Text
  lviKeyLen = Len(lvsKeyString)
  If lviKeyLen > 0 Then
    With ljCombo
      lviIndex = SrchComboList(.hWnd, lvsKeyString, False)
      If lviIndex <> -1 Then
        '.SetFocus
        .ListIndex = -1
        .ListIndex = lviIndex
        .SelStart = lviKeyLen
        .SelLength = Len(.Text) - lviKeyLen
      End If
    End With
  End If
End Sub

Public Function SrchComboList(hWnd As Long, _
                                  lvsFind As String, _
                                  Optional fExact As Boolean = False) As Long
  'Finds an entry in a combo box that matches the specified prefix.
  'This search is not case-sensitive.
  'Returns:
  'if found - a valid listindex
  'Else -1
  Dim lvlSearchType As Long
 
  If Len(lvsFind) = 0 Then
    SrchComboList = -1
    Exit Function
  End If
 
  Select Case fExact
    Case True
      lvlSearchType = CB_FINDSTRINGEXACT
     Case False
      lvlSearchType = CB_FINDSTRING
  End Select
  SrchComboList = SendMessageByString(hWnd, lvlSearchType, -1, lvsFind)
End Function

0
 
LVL 4

Expert Comment

by:VincentLawlor
Comment Utility
Similar but not the same mine wraps the code nicely in a class and can be used with comboboxes and list controls.
And gives the option to output the results to a list.

Vin.
0
 
LVL 4

Expert Comment

by:wileecoy
Comment Utility
VincentLawlor,

When I type something in, and then want to go back and change it, it won't let me backspace or replace the first chr of the combo box or the textbox.

Any ideas?

Thanks - Wileecoy.
0
 
LVL 2

Expert Comment

by:PeteD
Comment Utility
If you use a DataCombo or DBCombo then it has this fuctionality as one of its own properties ... DBCombo1.MatchEntry = dblExtendedMatching


otherwise try my long winded workaround:

'***************************************************************************
' Created by Peter Dobson on 04/01/01 in order to provide AutoComplete
' functionality for ComboBox's with .Style set to 0, and for the ComboBox's
' to have the option to restrict Combo's data to one of the ListItem's -
' (see defect 2884)
'
' e.g. of how To use (form code):
'    Private Sub Combo1_GotFocus()
'        AutoComboGotFocus
'    End Sub
'    Private Sub Combo1_Click()
'        AutoComboClickCheck Combo1
'    End Sub
'    Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
'        KeyCode = AutoComboKeyDownCheck(Combo1, KeyCode)
'    End Sub
'    Private Sub Combo1_KeyPress(KeyAscii As Integer)
'        KeyAscii = AutoComboFind(Combo1, KeyAscii, True)
                                            'False allows non-list data
'    End Sub
'    Private Sub Combo1_Validate(Cancel As Boolean)
'       AutoComboKeyDownCheck(Combo1, vbKeyTab)
'    End Sub
'***************************************************************************

'module code
'Modification History
'====================
'Changed By      Date      Fault   Description
'==========      ====      =====   ==============
'Peter Dobson   06/06/01   5154    Fixed bug when backspace/tab is pressed
'***************************************************************************
Option Explicit

Private mnLastIndex As Integer
Private mbJustTypeSelected As Boolean

Public Property Let AutoComboDrop(ByRef cboThis As ComboBox, ByVal _
    bState As Boolean)
' Set whether combo drops down using the Down Arrow or not:
    SendMessageLong cboThis.hWnd, CB_SETEXTENDEDUI, Abs(bState), 0
End Property

Public Property Get AutoComboDrop(ByRef cboThis As ComboBox) As Boolean
' Get whether combo drops down using the Down Arrow or not:
    AutoComboDrop = (SendMessageLong(cboThis.hWnd, CB_GETEXTENDEDUI, 0, 0) <> 0)
End Property

Public Function AutoComboFind(ByRef cboCurrent As ComboBox, ByVal _
    KeyAscii As Integer, Optional ByVal LimitToList As Boolean = False)

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lCB As Long, sFindString As String
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

   
    On Error GoTo Err_Handler
   
    If KeyAscii = 8 Then
        AutoComboFind = KeyAscii
        Exit Function
    ElseIf KeyAscii < 32 Or KeyAscii > 255 Then
        Exit Function
    Else
        If cboCurrent.SelLength = 0 Then
            sFindString = UCase(cboCurrent.Text & Chr$(KeyAscii))
        Else
            sFindString = Left$(cboCurrent.Text, cboCurrent.SelStart) & _
                Chr$(KeyAscii)
        End If
    End If
   
    lCB = SendMessage(cboCurrent.hWnd, CB_FINDSTRING, -1, ByVal sFindString)
    If lCB <> CB_ERR Then
        cboCurrent.ListIndex = lCB
        cboCurrent.SelStart = Len(sFindString)
        cboCurrent.SelLength = Len(cboCurrent.Text) - cboCurrent.SelStart
        AutoComboFind = 0
    Else
        If LimitToList = True And cboCurrent.ListCount > 0 Then
            AutoComboFind = 0
        Else
            AutoComboFind = KeyAscii
        End If
    End If
Err_Handler:
End Function

Public Sub AutoComboClickCheck(cboCurrent As ComboBox)
'Required because of the very strange behaviour of combo's where
'the combo's click event is fired and the current selection is lost
'when the control loses focus or its down arrow is re-clicked
    If mbJustTypeSelected = True Then
        cboCurrent.ListIndex = mnLastIndex
        mbJustTypeSelected = False
    End If
End Sub

Public Function AutoComboKeyDownCheck(cboCurrent As ComboBox, KeyCode As Integer) As Integer
'Although Tab keypress cannot be trapped without a keyboard hook the
'vbKeyTab constant can be passed form the combo's validate event
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        cboCurrent.SelStart = 0
        cboCurrent.SelLength = Len(cboCurrent.Text)
        mnLastIndex = cboCurrent.ListIndex
        mbJustTypeSelected = True
        If KeyCode = vbKeyReturn Then
            SendKeys "{ESC}" 'make the list disapear but keep the focus
        End If
    Else
        AutoComboKeyDownCheck = KeyCode
    End If
End Function

Public Sub AutoComboGotFocus()
    mbJustTypeSelected = False
End Sub
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 4

Expert Comment

by:VincentLawlor
Comment Utility
wileecoy
>>When I type something in, and then want to go back and change it, it won't let me backspace or replace
the first chr of the combo box or the textbox.
Any ideas?

Just remove the checks for intKey = 8

or just add the following line to the start of the code
FindIndexStr

If intKey = 8 then exit sub

Vin.
0
 
LVL 4

Expert Comment

by:escheider
Comment Utility
If you have your combo box loaded, why not just set the combo box style property to dropdown list.  Then, when you push a letter, it will find the closest match.  Unless you mean it filters out the combo box to only display the selected items.
0
 
LVL 4

Expert Comment

by:wileecoy
Comment Utility
Ta-Da!

As you can see I plugged in the code and hit F5 - I didn't look through to see what the code does.

Works well.

Thanks.
0
 
LVL 1

Expert Comment

by:dekeldate
Comment Utility
wileecoy
>>When I type something in, and then want to go back and change it, it won't let me backspace or replace

Try this

add a combobox to a new form

paste the following code to the form

'Windows declarations
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
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
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)

'Private flag
Private m_bEditFromCode As Boolean


Private Sub Form_Load()
    Dim sSysDir As String, sFile As String

    'Get files from system directory for test list
    Screen.MousePointer = vbHourglass
    sSysDir = Space$(256)
    GetSystemDirectory sSysDir, Len(sSysDir)
    sSysDir = Left$(sSysDir, InStr(sSysDir, Chr$(0)) - 1)
    If Right$(sSysDir, 1) <> "\" Then
        sSysDir = sSysDir & "\"
    End If
    sFile = Dir$(sSysDir & "*.*")
    Do While Len(sFile)
        Combo1.AddItem sFile
        sFile = Dir$
    Loop
    Screen.MousePointer = vbDefault
End Sub

'Certain keystrokes must be handled differently by the Change
'event, so set m_bEditFromCode flag if such a key is detected
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDelete
            m_bEditFromCode = True
        Case vbKeyBack
            m_bEditFromCode = True
    End Select
End Sub

Private Sub Combo1_Change()
    Dim i As Long, j As Long
    Dim strPartial As String, strTotal As String

    'Prevent processing as a result of changes from code
    If m_bEditFromCode Then
        m_bEditFromCode = False
        Exit Sub
    End If
    With Combo1
        'Lookup list item matching text so far
        strPartial = .Text
        i = SendMessage(.hwnd, CB_FINDSTRING, -1, ByVal strPartial)
        'If match found, append unmatched characters
        If i <> CB_ERR Then
            'Get full text of matching list item
            strTotal = .List(i)
            'Compute number of unmatched characters
            j = Len(strTotal) - Len(strPartial)
            '
            If j <> 0 Then
                'Append unmatched characters to string
                m_bEditFromCode = True
                .SelText = Right$(strTotal, j)
                'Select unmatched characters
                .SelStart = Len(strPartial)
                .SelLength = j
            End If
        End If
    End With
End Sub

press F5

this is slightly modified from code I got at http://www.softcircuits.com
0
 
LVL 1

Expert Comment

by:raybeam
Comment Utility
work on the Change event instead...
it's better to use a Text Box with this, if your list is in a Database your SQL statment should be something like this in the change event:

SET rs = cn.execute("SELECT * FROM TableName WHERE FieldName like '%" TextBox.Text "%'")

TextBox.Text = rs("FieldName")

Regards,

RayZor
0
 

Author Comment

by:mscala
Comment Utility
Perfect!!!!
Thanks
0
 
LVL 4

Expert Comment

by:wileecoy
Comment Utility
Thanks - you generated a lot of solutions using different controls and got some good code.

This will be a great value for someone that buys this solution in the future.

btw - nice code VincentLawlor.

Thanks

Wileecoy.
0
 
LVL 1

Expert Comment

by:dekeldate
Comment Utility
right on wileecoy.

This was a great learning experiance.

Liked your code VincentLawlor. I am a great fan of class solutions.
0
 
LVL 4

Expert Comment

by:VincentLawlor
Comment Utility
Glad to be of service.

No points though sniff sniff :(

Vin.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now