Inputs: ctlSource: The Source control (ComboBox or TextBox in case to search in ListBox) str: The string to search (i.e. .Text) intKey : Keycode of Key pressed (i.e. KeyAscii Parameter in KeyPress Event) Optional ctlTarget : If to search in ListBox The ListBox Control
Assumes: Usage: ' 1 - In the module declaration declare Dim cBS As New clsBoxSearch ' 2 - Write on TextBox or ComboBox Keypress event Private Sub cmbSearch_KeyPress(KeyAscii As Integer) cBS.FindIndexStr cmbSearch, cmbSearch.Text, KeyAscii End Sub Private Sub txtSearchItem_KeyPress(KeyAscii As Integer) cBS.FindIndexStr txtSearchItem, txtSearchItem.Text, KeyAscii, lstSearchName End Sub
Code Returns: None: Just sets the ListIndex to the Found String
Side Effects: None
Api Declarations: '********************************************************************** 'Declaration for Search Routines in ListBox (LB) and ComboBox (CB) Public Const LB_FINDSTRING As Long = &H18F Public Const LB_FINDSTRINGEXACT As Long = &H1A2 Public Const CB_ERR As Long = (-1) Public Const LB_ERR As Long = (-1) Public Const WM_USER As Long = &H400 Public Const CB_FINDSTRING As Long = &H14C Public Const CB_SHOWDROPDOWN As Long = &H14F Public 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 '***********************************************************************
Option Explicit
Public Sub FindIndexStr(ctlSource As Control, _
ByVal str As String, intKey As Integer, _
Optional ctlTarget 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
If intKey = 13 Then Exit Sub '???
lngIdx = SendMessageStr(ctlTarget.hWnd, _
LB_FINDSTRING, -1, FindString)
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
'Search For ComboBox Item (First press)
Dim c1 As String 'input Char
Dim notempLoop As Boolean
'-----------------------------------------
'-----------------------------------------
'Search For ComboBox Item - DropDownList Mode (First press)
'work in the combo_KeyPress
Sub LinkCombo(Comb As ComboBox, KeyAscii As Integer)
If (KeyAscii = 9 Or KeyAscii = 13) Then: Exit Sub
'ap.openComb 40, Comb
c1 = Chr(KeyAscii)
notempLoop = False
search1 Comb, Comb.ListIndex
End Sub
Private Sub search1(Comb As ComboBox, listnum As Integer)
Dim mloop As Integer 'loop Helper
Dim lo As Boolean 'exit loop condition
Static strhelp As String
Static strhelpNum As Integer
lo = True
l1:
If (notempLoop) Then: Comb.ListIndex = -1: Exit Sub
For mloop = listnum To Comb.ListCount - 1
If (strhelp = Comb.List(mloop) And strhelpNum = mloop) Then: mloop = mloop + 1
If (Mid$(Comb.List(mloop), 1, 1) = c1) Then
strhelp = Comb.List(mloop): strhelpNum = mloop: Comb.ListIndex = mloop: Exit Sub
end if
Next mloop
If (lo) Then
listnum = 0
lo = False
strhelp = ""
GoTo l1
Else
Comb.ListIndex = -1
notempLoop = True
End If
End Sub
'-----------------------------------------
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
