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 FunctionHere'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 oleexp3.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 SubCode:
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 FunctionRequirements
-oleexpimp.tlb v2.0 - 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.
-oleexp3.tlb v3.8 - New version released with this project (29 Sep 2016)
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.