MonAutoComplete.ctl

 VERSION 5.00
Begin VB.UserControl AutoCompleteV2
   ClientHeight    =   405
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2670
   ScaleHeight     =   405
   ScaleWidth      =   2670
   Begin VB.TextBox Text
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2655
   End
   Begin VB.ComboBox Combo1
      CausesValidation=   0   'False
      Height          =   315
      ItemData        =   "MonAutoComplete.ctx":0000
      Left            =   0
      List            =   "MonAutoComplete.ctx":0016
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   1680
      Width           =   3015
   End
End
Attribute VB_Name = "AutoCompleteV2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'#########################################################################################
'## This user control features an autocomplete feature by utilizing a combobox control  ##
'## created by Raymond Piniones                                                         ##
'## r_piniones@yahoo.com                                                                ##
'#########################################################################################
Option Explicit
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
Const CB_SHOWDROPDOWN = &H14F
Const CB_GETDROPPEDSTATE = &H157


Private status As Boolean

Public Sub SetFontSize(ByVal tFontSize As Single)
On Error Resume Next
Text.FontSize = tFontSize
Combo1.FontSize = Text.FontSize

End Sub

Private Sub ComboBoxOpenList(cbo As ComboBox, Optional showIt As Boolean = True)
    SendMessage cbo.hwnd, CB_SHOWDROPDOWN, showIt, ByVal 0&
End Sub
'Function ComboBoxIsListVisible(cbo As ComboBox) As Boolean
'    ComboBoxIsListVisible = SendMessage(cbo.hwnd, CB_GETDROPPEDSTATE, 0, _
'        ByVal 0&)
'End Function


Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)


If KeyCode = 13 Then
Text.Text = Combo1.Text
Text.SetFocus
End If
End Sub
Public Function getStatus() As Boolean

getStatus = status

End Function

Private Sub Text_Change()
'If ComboBoxIsListVisible(Combo1) Then Exit Sub
'On Error GoTo errHandler






ComboBoxOpenList Combo1, True
Text.SetFocus
'Exit Sub
'errHandler:
'MsgBox Err.Description
End Sub
'Private Sub addToCombo(ByVal STR As String)
'Combo1.AddItem STR
'End Sub
'
'Private Sub clearCombo()
'Combo1.Clear
'End Sub




Private Sub UserControl_ExitFocus()
status = False
End Sub

Private Sub UserControl_GotFocus()
status = True
End Sub

Private Sub UserControl_Initialize()





With Combo1
'.Height = Text.Height
.Width = Text.Width
.Top = Text.Top
.Left = Text.Left
.FontSize = Text.FontSize
.FontName = Text.FontName
.BackColor = Text.BackColor
.ForeColor = Text.ForeColor
.FontBold = Text.FontBold




End With
End Sub




Private Sub Text_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
Combo1.SetFocus
SendKeys "{DOWN}"
End If
End Sub




Private Sub UserControl_Resize()

With Text
Text.Height = ScaleHeight
Text.Width = ScaleWidth
End With
With Combo1
.Top = Text.Top
.Left = Text.Left
.Width = Text.Width
End With
End Sub


Public Sub AddToCombo(ByVal str As String)
Combo1.AddItem str
End Sub
Public Sub ClearCombo()
Combo1.Clear
End Sub
Public Function getText() As String
getText = Replace(Trim(Text.Text), "'", "''")
End Function

Project Homepage: