dcsimg
Results 1 to 1 of 1

Thread: [VB6] Using IAutoComplete / IAutoComplete2 including autocomplete with custom lists

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,229

    [VB6] Using IAutoComplete / IAutoComplete2 including autocomplete with custom lists

    IAutoComplete / IAutoComplete2 / IEnumString

    SHAutocomplete has many well known limitations, the biggest being if you want to supply your own list to use with it. I was very impressed with Krool's work on this interface, and not wanting to include a whole other TLB set out to do it with oleexp.

    Turns out it's far easier to work with using oleexp; the only major limitation being how to go about handling multiple autocompletes with different custom lists. UPDATE: Previously this class couldn't support multiple custom lists for different controls because the v-table swapping method was only passing IEnumString, rather than a full cEnumString class. If it were possible to get the full class, one might expect to be able to just change it to As cEnumString - but that didn't work. However changing it to a Long to get the pointer itself actually produced a pointer to the full instance of the class, and voilą, the undocumented-but-ever-useful vbaObjSetAddRef to the rescue, a reference to the class instance is born!
    Code:
    'Before:
    'Public Function EnumStringNext(ByVal this As oleexpimp.IEnumString, ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
    'now:
    Public Function EnumStringNext(ByVal this As Long, ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
    Dim cObj As cEnumString
    vbaObjSetAddRef cObj, this
    If (cObj Is Nothing) = False Then
        EnumStringNext = cObj.IES_Next(celt, rgelt, pceltFetched)
    Else
        Debug.Print "esn obj fail"
    End If
    
    End Function
    Finally, IAutoCompleteDropdown is used to provide the status of the dropdown autosuggest list. The .DropdownStatus method reports whether it's down, and the text of an item if an item in the list is selected. In the sample project, this is run on an automatically updated timer enabled in the 'basic filesystem' routine. It also exposes the .ResetEnumerator call to update the dropdown list while it's open.

    Here's what the code looks like:

    cAutoComplete.cls
    Code:
    Option Explicit
    
    Private pACO As AutoComplete
    Private pACL As ACListISF
    Private pACL2 As IACList2
    Private pACLH As ACLHistory
    Private pACLMRU As ACLMRU
    Private pACM As ACLMulti
    Private pObjMgr As IObjMgr
    Private pDD As IAutoCompleteDropDown
    Private pUnk As oleexp.IUnknown
    Private m_hWnd As Long
    Private pCust As cEnumString
    
    Private Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long)
    
    Private Sub Class_Initialize()
    Set pACO = New AutoComplete
    End Sub
    
    Public Sub AC_Filesys(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
    Set pACL = New ACListISF
    pACO.Init hWnd, pACL, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
    End Sub
    Public Sub AC_Disable()
    pACO.Enable 0
    End Sub
    Public Sub AC_Enable()
    pACO.Enable 1
    End Sub
    Public Sub AC_Custom(hWnd As Long, sTerms() As String, lOpt As AUTOCOMPLETEOPTIONS)
    Set pCust = New cEnumString
    pCust.SetACStringList sTerms
    pACO.Init hWnd, pCust, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
    End Sub
    Public Sub AC_ACList2(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS, lOpt2 As AUTOCOMPLETELISTOPTIONS)
    Set pACL = New ACListISF
    Set pACL2 = pACL
    If (pACL2 Is Nothing) = False Then
        pACL2.SetOptions lOpt2
        pACO.Init hWnd, pACL2, "", ""
        pACO.SetOptions lOpt
        pACO.Enable 1
        m_hWnd = hWnd
    Else
        Debug.Print "Failed to create IACList2"
    End If
    End Sub
    Public Sub AC_History(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
    Set pACLH = New ACLHistory
    pACO.Init hWnd, pACLH, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
    
    End Sub
    Public Sub AC_MRU(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS)
    Set pACLMRU = New ACLMRU
    pACO.Init hWnd, pACLMRU, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
    
    End Sub
    
    Public Sub AC_Multi(hWnd As Long, lOpt As AUTOCOMPLETEOPTIONS, lFSOpts As AUTOCOMPLETELISTOPTIONS, bFileSys As Boolean, bHistory As Boolean, bMRU As Boolean, bCustom As Boolean, Optional vStringArrayForCustom As Variant)
    
       On Error GoTo e0
    
    Set pACM = New ACLMulti
    Set pObjMgr = pACM
    
    If bFileSys Then
        Set pACL = New ACListISF
        Set pACL2 = pACL
        pACL2.SetOptions lFSOpts
        pObjMgr.Append pACL2
    End If
    If bMRU Then
        Set pACLMRU = New ACLMRU
        pObjMgr.Append pACLMRU
    End If
    If bHistory Then
        Set pACLH = New ACLHistory
        pObjMgr.Append pACLH
    End If
    If bCustom Then
        Dim i As Long
        Dim sTerms() As String
        ReDim sTerms(UBound(vStringArrayForCustom))
        For i = 0 To UBound(vStringArrayForCustom)
            sTerms(i) = vStringArrayForCustom(i)
        Next i
        Set pCust = New cEnumString
        pCust.SetACStringList sTerms
        pObjMgr.Append pCust
    End If
    
    pACO.Init hWnd, pObjMgr, "", ""
    pACO.SetOptions lOpt
    pACO.Enable 1
    m_hWnd = hWnd
       On Error GoTo 0
       Exit Sub
    
    e0:
    
        Debug.Print "cAutocomplete.AC_Multi.Error->" & Err.Description & " (" & Err.Number & ")"
    
    End Sub
    
    Public Function DropdownStatus(lpStatus As Long, sText As String)
    If pDD Is Nothing Then
        Set pDD = pACO
    End If
    Dim lp As Long
    
    pDD.GetDropDownStatus lpStatus, lp
    SysReAllocString VarPtr(sText), lp
    CoTaskMemFree lp
    
    End Function
    Public Sub ResetEnum()
    If pDD Is Nothing Then
        Set pDD = pACO
    End If
    pDD.ResetEnumerator
    End Sub
    Implementing IEnumString's functions:
    Code:
    Public Function IES_Next(ByVal celt As Long, ByVal rgelt As Long, ByVal pceltFetched As Long) As Long
    Dim lpString As Long
    Dim i As Long
    Dim celtFetched As Long
    If rgelt = 0 Then
        IES_Next = E_POINTER
        Exit Function
    End If
    
    For i = 0 To (celt - 1)
        If nCur = nItems Then Exit For
        lpString = CoTaskMemAlloc(LenB(sItems(nCur)) & vbNullChar)
        If lpString = 0 Then IES_Next = S_FALSE: Exit Function
        
        CopyMemory ByVal lpString, ByVal StrPtr(sItems(nCur)), LenB(sItems(nCur) & vbNullChar)
        CopyMemory ByVal UnsignedAdd(rgelt, i * 4), lpString, 4&
        
        nCur = nCur + 1
        celtFetched = celtFetched + 1
    Next i
     If pceltFetched Then
        CopyMemory ByVal pceltFetched, celtFetched, 4&
     End If
     If i <> celt Then IES_Next = S_FALSE
    
    End Function
    Public Function IES_Skip(ByVal celt As Long) As Long
    If nCur + celt <= nItems Then
        nCur = nCur + celt
        IES_Skip = S_OK
    Else
        IES_Skip = S_FALSE
    End If
    End Function
    For the complete code, see the attached project.

    Requirements
    -oleexpimp.tlb v2.0 or higher - I've forked and continued olelib2.tlb much the same as I did with the original. This new file replaces olelib2 in the same way oleexp3 replaces olelib (you can run search and replace). This file is included in the main oleexp download.
    -oleexp.tlb v4.0 or higher - Rev. 3 updated to use oleexp 4.0 or higher
    Thanks
    Krool's project mentioned above is what inspired me to do this, and I borrowed a few techniques from his project, especially for IEnumString.

    Updates
    cAutocomplete Rev 4 (28 Dec 2016)

    -Added sub to update custom terms lists on the fly
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width