• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• Auto - Select Combo Box for Quick Search

Auto - Select Combo Box for Quick Search

Auto - Select Combo Box for Quick Search

API Declarations


'Program Title:Auto Search Combo Box OCX
'Date : 9 May 2006, 10 May 2006
'Author: Cyrus Lacaba - Death ®
'Place: Las Piñas City, Philippines'
'Free to Edit and to Use


Option Explicit
Private m_DecimalEntry As Boolean
Private m_collection() As String
Private a As New Collection
Private b As New Collection
Private m_lngpopulated&
Private strconcat$

'-----------------------
Public Event Click()
Public Event DblClick()



Rate Auto - Select Combo Box for Quick Search

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

    Text = Combo1.Text
End Property

Public Property Let Text(ByVal NewValue As String)
    Combo1.Text = NewValue
End Property

Private Sub Combo1_Click()
    RaiseEvent Click
End Sub

Private Sub Combo1_DblClick()
    RaiseEvent DblClick
End Sub

Public Property Get NewIndex() As Integer
    NewIndex = Combo1.NewIndex
End Property

Public Property Let NewIndex(ByVal NewValue As Integer)
    Combo1.NewIndex = NewValue
End Property

Public Property Get ItemData(ByVal Index As Integer) As Long

    ItemData = Combo1.ItemData(Index)

End Property

Public Property Let ItemData(ByVal Index As Integer, ByVal NewValue As Long)

    Combo1.ItemData(Index) = NewValue

End Property

Public Property Get ListIndex() As Long
    ListIndex = Combo1.ListIndex
End Property

Public Property Let ListIndex(ByVal NewValue As Long)
    Combo1.ListIndex = NewValue
End Property

Public Property Get ListCount() As Long
    ListCount = Combo1.ListCount
End Property

Private Sub Combo1_KeyUp(KeyCode As Integer, Shift As Integer)
Static md&, i&, p&
    
    Select Case KeyCode
        Case vbKeyLButton, _
            vbKeyRButton, _
            vbKeyCancel, _
            vbKeyMButton, _
            vbKeyTab, _
            vbKeyClear, _
            vbKeyReturn, _
            vbKeyShift, _
            vbKeyControl, _
            vbKeyMenu, _
            vbKeyPause, _
            vbKeyCapital, _
            vbKeyEscape, _
            vbKeySpace, _
            vbKeyPageUp, _
            vbKeyPageDown, _
            vbKeyEnd, _
            vbKeyHome, _
            vbKeyLeft, _
            vbKeyUp, _
            vbKeyRight, _
            vbKeyDown, _
            vbKeySelect, _
            vbKeyPrint
            Exit Sub
        Case vbKeyExecute, _
            vbKeySnapshot, _
            vbKeyInsert, _
            vbKeyHelp, _
            vbKeyNumlock, _
            vbKeyF1, _
            vbKeyF2, _
            vbKeyF3, _
            vbKeyF4, _
            vbKeyF5, _
            vbKeyF6, _
            vbKeyF7, _
            vbKeyF8, _
            vbKeyF9, _
            vbKeyF10, _
            vbKeyF11, _
            vbKeyF12, _
            vbKeyF13, _
            vbKeyF14, _
            vbKeyF15, _
            vbKeyF16
            Exit Sub
    End Select

    If a.Count = 0 Then Exit Sub
    
    strconcat$ = Combo1.Text
    
    Set b = New Collection
    
    If Combo1.Text <> vbNullString Then
        If ClearCollectionB(b) = False Then Exit Sub
        For i = 1 To a.Count
            If InStr(1, a.Item(i), Combo1.Text) = 1 Then
                 b.Add a.Item(i)
            End If
        Next
        m_lngpopulated = b.Count
    Else
        If ClearCollectionB(b) = False Then Exit Sub
        Combo1.Clear
        For i = 1 To a.Count
            Combo1.AddItem a.Item(i)
        Next
        Exit Sub
    End If

    If b.Count = m_lngpopulated Then
        If md& = 0 Then
            Do While Combo1.ListCount <> 0
               Combo1.RemoveItem Combo1.ListCount - 1
               DoEvents
            Loop
        End If
        
        For p = 1 To b.Count
            Combo1.AddItem b.Item(p)
            md& = 1
        Next
        
        If Combo1.ListCount <> 0 Then
            Combo1.Text = Combo1.List(0)
            Combo1.SelStart = Len(strconcat$)
            Combo1.SelLength = Len(Combo1.Text) - 1
        End If
        
        If Combo1.ListCount = m_lngpopulated Then
            md& = 0
        End If
    End If
    
End Sub

Private Sub UserControl_Initialize()
    Combo1.Top = 0
    Combo1.Left = 0
    Combo1.Width = UserControl.Width
    Combo1.Text = "Auto Select Combo by Cyrus ®"
    'UserControl.Height = Combo1.Height + 500
    
    
End Sub

Private Sub UserControl_Resize()
    Combo1.Top = 0
    Combo1.Left = 0
    Combo1.Width = UserControl.Width
    UserControl.Height = Combo1.Height
End Sub

Private Function ClearCollectionB(m_collection As Collection) As Boolean
On Error GoTo ErrorHandler
Dim i&
    
    For i = 1 To m_collection.Count
        m_collection.Remove i
    Next
    
    ClearCollectionB = True
    Exit Function
    
ErrorHandler:

    ClearCollectionB = False
    
End Function

Public Sub RemoveItem(ByVal Index As Long)

    Combo1.RemoveItem Index
    a.Remove Index
    
End Sub

Public Sub AddItem(ByVal Item As String)

    Combo1.AddItem Item
    a.Add Item
    
End Sub

Public Sub Clear()

    Combo1.Clear
    Call ClearCollectionB(a)
    
End Sub

'Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
'    RaiseEvent KeyDown(KeyCode, Shift)
'End Sub


'end of set font

'set mousepointer
Public Property Get MousePointer() As MousePointerConstants

    MousePointer = UserControl.MousePointer

End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)

  ' Validation is supplied by UserControl.

    Let UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"

End Property

'end of set mousepointer

'set mouseicon
Public Property Get MouseIcon() As Picture

    Set MouseIcon = UserControl.MouseIcon

End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)

    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"

End Property

Public Property Get DecimalEntry() As Boolean

    DecimalEntry = m_DecimalEntry

End Property

Public Property Let DecimalEntry(ByVal NewValue As Boolean)

    m_DecimalEntry = NewValue

End Property

'Appended by Cyrus for Text Box Key Press
Private Sub KeyPress_Decimal(EntryType As Long, objControl As Control, KeyPress As Integer, Optional ByVal Places As Integer = 2)

     If EntryType = 1 Then
        If KeyPress = vbKeyBack Then Exit Sub
        If Not (Chr(KeyPress) >= "0" And Chr(KeyPress) <= "9") And (Chr(KeyPress) <> ".") And (Chr(KeyPress) <> "-") Then
            KeyPress = 0
        End If
        'Check for multiple occurence of "."
        If Chr(KeyPress) = "." Then
            If InStr(objControl.Text, ".") <> 0 Then
                KeyPress = 0
            End If
        End If
        If Chr(KeyPress) = "-" Then
            If InStr(objControl.Text, "-") <> 0 Or objControl.SelStart <> 0 Then
                KeyPress = 0
            End If
        End If    'Check for decimal places allow only 2
        If InStr(objControl.Text, ".") <> 0 Then
            If InStr(objControl.Text, ".") < objControl.SelStart Then
            If Len(Mid(objControl.Text, InStr(objControl.Text, ".") + 1)) > (Places - 1) Then
                KeyPress = 0
            End If
            End If
        End If
    End If
End Sub