tags:

views:

35

answers:

0

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