• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• Updated Version of Auto Select Combo Box

Updated Version of Auto Select Combo Box

Updated Version of Auto Select Combo Box

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'
'Email: [email protected]
' [email protected]


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

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




Rate Updated Version of Auto Select Combo Box

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Public Property Get Text() As String
    Text = Combo1.Text
End Property

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

Public Property Get Enabled() As Boolean
    Enabled = Combo1.Enabled
End Property

Public Property Let Enabled(ByVal NewValue As Boolean)
    Combo1.Enabled = NewValue
End Property

Public Property Get Locked() As Boolean
    Locked = Combo1.Locked
End Property

Public Property Let Locked(ByVal NewValue As Boolean)
    Combo1.Locked = 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
    c.Add 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&
Dim strItem$, strItemID$
    
    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) & ":" & c.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)
            Combo1.ItemData(Combo1.NewIndex) = c.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
            strItem$ = Trim(Mid(b.Item(p), 1, InStr(1, b.Item(p), ":") - 1))
            strItemID$ = Trim(Mid(b.Item(p), Len(strItem$) + 2))
            Combo1.AddItem strItem$
            Combo1.ItemData(Combo1.NewIndex) = strItemID$
            md& = 1
        Next
        
        If Combo1.ListCount <> 0 Then
            'Check This Out
            Combo1.Text = Combo1.List(0)
            Combo1.ListIndex = 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 + 1
    c.Remove Index + 1
    
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