1) I am using the code of Search as you type combobox.The script works fine when records are selected from the combobox,but when I need to enter new I cannot enter.Especially If a name say Ramesha has already been entered in the database and I need to enter a name Ramesh, I am unable to do so.Please help me modify the code.I am using it in registration of new names where the combobox is used to help in registering new name by helping with common names Tutorial at http://www.vb6.us/tutorials/visual-basic-combo-box-tutorial Source code at http://www.vb6.us/files/VBPrograms/ComboBoxes/DBSearchAsYouType.zip 2)I am querying a field which is Yes/No.I want to add data when the answer is NO i.e 0. What code is more suitable
If adodc1.Recordset.("Status") = 0 then or
If adodc1.Recordset.("Status") <> -1 then
I am sorry but i did not know whether I should have pasted the code or not after giving the links Code for the first question in a form is
Option Explicit
Private Sub Form_Load()
InitializeDB
End Sub
Private Sub Form_Unload(Cancel As Integer)
DisconnectDB
End Sub
Private Sub cboCompany_GotFocus()
gstrATCDBTableName = "Company"
gstrATCDBFieldName = "CompanyName"
gblnGetAllData = optAllItems.Value
gblnDropDownOnFocus = IIf(chkShowDropDown.Value = vbChecked, True, False)
AutoTypeComboGotFocus cboCompany
End Sub
Private Sub cboCompany_KeyDown(KeyCode As Integer, Shift As Integer)
AutoTypeComboKeyDown cboCompany, KeyCode, Shift
End Sub
Private Sub cboCompany_KeyPress(KeyAscii As Integer)
AutoTypeComboKeyPress Me, cboCompany, KeyAscii
End Sub
Private Sub cboCompany_Change()
AutoTypeComboChange cboCompany
End Sub
Private Sub cboCompany_LostFocus()
AutoTypeComboLostFocus cboCompany
End Sub
Private Sub cmdRefresh_Click()
Dim objTestRst As ADODB.Recordset
If Trim$(cboCompany.Text) = "" Then Exit Sub
gobjCmd.CommandText = "SELECT COUNT(*) AS CompanyCount FROM Company " _
& " WHERE UCASE(CompanyName) = '" _
& UCase$(Replace$(cboCompany.Text, "'", "''")) & "'"
Set objTestRst = gobjCmd.Execute
If objTestRst("CompanyCount") = 0 Then
gobjCmd.CommandText = "INSERT INTO Company(CompanyName) " _
& " VALUES('" & Replace$(cboCompany.Text, "'", "''") & "')"
gobjCmd.Execute
cboCompany.AddItem cboCompany.Text
End If
End Sub
Code placed in a module
Option Explicit
Public gstrATCDBTableName As String
Public gstrATCDBFieldName As String
Public gblnGetAllData As Boolean ' true = get all entries, false = go by 1st letter
Public gblnDropDownOnFocus As Boolean
Private Const CB_FINDSTRING As Long = &H14C
Private Const CB_SHOWDROPDOWN As Long = &H14F
Private Const LB_FINDSTRING As Long = &H18F
Private Const CB_ERR As Long = (-1)
Private Const CB_GETITEMHEIGHT As Long = &H154
Private Const CB_SETDROPPEDWIDTH As Long = &H160
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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 Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private gblnATCIgnoreTextChange As Boolean
Private gblnATCTextDeleted As Boolean
Private gintATCSelStart As Integer
Private gintATCSelLen As Integer
'----------------------------------------------------------------
Public Sub AutoTypeComboGotFocus(pobjCombo As ComboBox)
'----------------------------------------------------------------
' Select existing text on entry to the combo box
pobjCombo.SelStart = 0
pobjCombo.SelLength = Len(pobjCombo.Text)
' if currently populated, drop it down
If pobjCombo.ListCount > 0 And gblnDropDownOnFocus Then
SendMessage pobjCombo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
End If
End Sub
'---------------------------------------------------------------------------------
Public Sub AutoTypeComboKeyDown(pobjCombo As ComboBox, _
KeyCode As Integer, _
Shift As Integer)
'---------------------------------------------------------------------------------
' If the full text is selected and the user presses a letter or number,
' the selected text should be replaced
If pobjCombo.SelText = pobjCombo.Text _
And ((KeyCode >= vbKeyA And KeyCode <= vbKeyZ) Or _
(KeyCode >= vbKey0 And KeyCode <= vbKey9)) _
Then
pobjCombo.Text = ""
gblnATCTextDeleted = False
pobjCombo.Refresh
Exit Sub
End If
' If a user presses the "Delete" key, then the selected text
' is removed.
If KeyCode = vbKeyDelete And pobjCombo.SelText <> "" Then
' Make sure that the text is not automatically re-entered
' as soon as it is deleted
gblnATCIgnoreTextChange = True
gintATCSelStart = pobjCombo.SelStart + 1
gintATCSelLen = pobjCombo.SelLength
pobjCombo.SelText = ""
KeyCode = 0
gblnATCTextDeleted = True
Else
gblnATCTextDeleted = False
End If
End Sub
'---------------------------------------------------------------------------------
Public Sub AutoTypeComboKeyPress(pobjForm As Form, _
pobjCombo As ComboBox, _
KeyAscii As Integer)
'---------------------------------------------------------------------------------
' If a user presses the "Backspace" key, then the selected text
' is removed. Autosearch is not re-performed, as that would only
' put it straight back again.
Dim objCtl As Control
If Len(pobjCombo.Text) = 0 Then
gblnATCIgnoreTextChange = False
LoadCombo pobjCombo, IIf(gblnGetAllData, "", Chr$(KeyAscii))
If pobjCombo.ListCount > 0 Then
SetDropDownHeight pobjForm, pobjCombo, IIf(pobjCombo.ListCount < 8, _
pobjCombo.ListCount, 8)
End If
pobjForm.Refresh
On Error Resume Next
For Each objCtl In pobjForm.Controls
objCtl.Refresh
Next
End If
If pobjCombo.ListCount > 0 Then
SetDropDownWidth pobjCombo
SendMessage pobjCombo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&
End If
If KeyAscii = 8 Then
gblnATCIgnoreTextChange = True
If Len(pobjCombo.SelText) > 0 Then
pobjCombo.SelText = ""
KeyAscii = 0
End If
End If
''if user presses enter, select the listindex
'If KeyAscii = 13 Then
' pobjCombo.ListIndex = SendMessage(pobjCombo.hwnd, _
' CB_FINDSTRING, _
' -1, _
' ByVal CStr(pobjCombo.Text))
'End If
End Sub
'---------------------------------------------------------------------------------
Public Sub AutoTypeComboChange(pobjCombo As ComboBox)
'---------------------------------------------------------------------------------
Dim i As Integer
Dim l As Long
Dim strNewText As String
' Check to see if a search is required.
If gblnATCTextDeleted Then Exit Sub
If Not gblnATCIgnoreTextChange And pobjCombo.ListCount > 0 Then
l = SendMessage(pobjCombo.hwnd, _
CB_FINDSTRING, _
-1, _
ByVal CStr(pobjCombo.Text))
strNewText = pobjCombo.List(l)
If Len(pobjCombo.Text) <> Len(strNewText) Then
' Partial match found
' Avoid recursively entering this event
gblnATCIgnoreTextChange = True
i = Len(pobjCombo.Text)
' Attach the full text from the list to what has already been entered.
' This technique preserves the case entered by the user.
pobjCombo.Text = pobjCombo.Text & Mid$(strNewText, i + 1)
' Select the text that is auto-entered
pobjCombo.SelStart = i
pobjCombo.SelLength = Len(Mid$(strNewText, i + 1))
End If
Else
' The IgnoreTextChange Flag is only effective for one Change event.
gblnATCIgnoreTextChange = False
End If
End Sub
'---------------------------------------------------------------------------------
Public Sub AutoTypeComboLostFocus(pobjCombo As ComboBox)
'---------------------------------------------------------------------------------
On Error Resume Next
If gblnATCTextDeleted Then
If Len(pobjCombo.Text) > 0 Then
pobjCombo.Text = Left$(pobjCombo.Text, gintATCSelStart - 1) & _
Mid$(pobjCombo.Text, gintATCSelStart + gintATCSelLen)
pobjCombo.AddItem pobjCombo.Text
End If
End If
End Sub
'---------------------------------------------------------------------------------
Public Sub LoadCombo(pobjCombo As ComboBox, pstrLetter As String)
'---------------------------------------------------------------------------------
Dim objRstDropDownData As ADODB.Recordset
Dim strSQL As String
Dim strWhereClause As String
Dim strWhereOrAnd As String
If pstrLetter = "" Then
strWhereClause = ""
strWhereOrAnd = " WHERE "
Else
strWhereOrAnd = " AND "
If UCase$(pstrLetter) >= "A" And UCase$(pstrLetter) <= "Z" Then
strWhereClause = " WHERE " & gstrATCDBFieldName & " LIKE '" & pstrLetter & "%'"
Else
strWhereClause = " WHERE " & gstrATCDBFieldName & " LIKE '[!A-Z]%'"
End If
End If
strSQL = ""
strSQL = strSQL & "SELECT " & gstrATCDBFieldName
strSQL = strSQL & " FROM " & gstrATCDBTableName
strSQL = strSQL & strWhereClause
strSQL = strSQL & strWhereOrAnd & gstrATCDBFieldName & " IS NOT NULL"
strSQL = strSQL & " AND TRIM(" & gstrATCDBFieldName & ") <> ''"
strSQL = strSQL & " ORDER BY " & gstrATCDBFieldName
gobjCmd.CommandText = strSQL
Set objRstDropDownData = gobjCmd.Execute
With pobjCombo
.Clear
Do Until objRstDropDownData.EOF
.AddItem objRstDropDownData.Fields(gstrATCDBFieldName)
objRstDropDownData.MoveNext
Loop
End With
objRstDropDownData.Close
Set objRstDropDownData = Nothing
End Sub
'---------------------------------------------------------------------------------
Public Sub SetDropDownHeight(pobjForm As Form, _
pobjCombo As ComboBox, _
plngNumItemsToDisplay As Long)
'---------------------------------------------------------------------------------
Dim pt As POINTAPI
Dim rc As RECT
Dim lngSavedWidth As Long
Dim lngNewHeight As Long
Dim lngOldScaleMode As Long
Dim lngItemHeight As Long
lngSavedWidth = pobjCombo.Width
lngOldScaleMode = pobjForm.ScaleMode
pobjForm.ScaleMode = vbPixels
lngItemHeight = SendMessage(pobjCombo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0)
lngNewHeight = lngItemHeight * (plngNumItemsToDisplay + 2)
Call GetWindowRect(pobjCombo.hwnd, rc)
pt.X = rc.Left
pt.Y = rc.Top
Call ScreenToClient(pobjForm.hwnd, pt)
Call MoveWindow(pobjCombo.hwnd, pt.X, pt.Y, pobjCombo.Height, lngNewHeight, True)
pobjForm.ScaleMode = lngOldScaleMode
pobjCombo.Width = lngSavedWidth
End Sub
'-----------------------------------------------------------------------------
Public Sub SetDropDownWidth(mCombo As ComboBox)
'-----------------------------------------------------------------------------
Dim RetVal As Long
Dim PixelWidth As Long
Dim MaxWidth As Long
Dim LoopCounter As Long
Dim lWidth As Long
For LoopCounter = 0 To mCombo.ListCount - 1
lWidth = mCombo.Parent.TextWidth(mCombo.List(LoopCounter))
If lWidth > MaxWidth Then
MaxWidth = lWidth
End If
Next LoopCounter
MaxWidth = MaxWidth + (23 * Screen.TwipsPerPixelX)
If MaxWidth > (mCombo.Width * 2) Then
MaxWidth = (mCombo.Width * 2)
ElseIf MaxWidth < mCombo.Width Then
MaxWidth = mCombo.Width
End If
PixelWidth = (MaxWidth \ Screen.TwipsPerPixelX)
RetVal = SendMessage(mCombo.hwnd, CB_SETDROPPEDWIDTH, PixelWidth, 0)
End Sub