How to use IAutoComplete together with TStringsAdapter? - delphi

Question

In this SO post, it is suggested to use IAutoComplete together with TStringsAdapter to implement auto-complete. The following code tries to follow the suggestion but fails enabling the autocomplete feature without compilation & runtime exceptioncomplaining unmatched/inconsistent interface... Could you help to comment about the underlying reason and the work around ?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, AxCtrls, StdVCL, ActiveX, ComObj;
const
IID_IAutoComplete = '{00bb2762-6a77-11d0-a535-00c04fd7d062}';
IID_IAutoComplete2 = '{EAC04BC0-3791-11d2-BB95-0060977B464C}';
CLSID_AutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
type
IAutoComplete = interface(IUnknown)
[IID_IAutoComplete]
function Init(hwndEdit: HWND; punkACL: IUnknown; pwszRegKeyPath: PWideChar;
pwszQuickComplete: PWideChar): HResult; stdcall;
function Enable(fEnable: Boolean): HResult; stdcall;
end;
IAutoComplete2 = interface(IAutoComplete)
[IID_IAutoComplete2]
function SetOptions(dwFlag: DWORD): HResult; stdcall;
function GetOptions(out dwFlag: DWORD): HResult; stdcall;
end;
TStringsAdapterCracker = class(TStringsAdapter);
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
private
FAutoComplete: IAutoComplete2;
FStrings: IUnknown;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
hEditControl: THandle;
begin
With ComboBox1 do begin
with Items do begin
BeginUpdate;
Clear;
Add('Alpha');
Add('Beta');
Add('Gamma');
Add('Delta');
EndUpdate;
end;
AutoComplete := False;
ItemIndex := 0;
end;
FAutoComplete := CreateComObject(CLSID_AutoComplete) as IAutoComplete2;
hEditControl := GetWindow(ComboBox1.Handle, GW_CHILD);
FStrings := TStringsAdapterCracker(TStringsAdapter.Create(ComboBox1.Items))._NewEnum;
OleCheck(FAutoComplete.Init(hEditControl, FStrings, nil, nil));
end;
end.
Note that related SO posts (here and here) use TEnumString to implement IEnumString manually instead of TStringsAdapter to work with IAutoComplete

Answer 1

Could you help to comment about the underlying reason and the work around ?
The reason the code fails is because the TStringsAdapters constructor tries to load a StdVCL type library and fails, raising a "library not registered" error:
constructor TStringsAdapter.Create(Strings: TStrings);
var
StdVcl: ITypeLib;
begin
OleCheck(LoadRegTypeLib(LIBID_STDVCL, 4, 0, 0, StdVcl)); // <-- fails!
inherited Create(StdVcl, IStrings);
FStrings := Strings;
end;
The TStringsAdapter object is being constructed in the form's OnCreate event, which is triggered after the form's constructor has exited, so the exception does not abort construction or terminate the process, but it does reach a default exception handler that displays an error popup message. Also, the exception is bypassing the call to FAutoComplete.Init(), so no enumerator is created or registered for the ComboBox.
Even though you have added StdVCL to your uses clause, that is not enough to get the StdVCL type library registered on the machine that your app is running on. You would have to distribute and register that type library as part of your app's installation setup.
The workaround is to use a TEnumString implementation that simply enumerates the TStrings values directly, thus avoiding that requirement. As well as it has a little bit less runtime overhead then using TStringsAdapter (whose _NewEnum() method creates a separate TStringsEnumerator object to perform the actual enumeration, so you are actually creating 2 objects instead of 1), but at the expense of having to write a bit more code to implement it, eg:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActiveX, ComObj;
const
IID_IAutoComplete = '{00bb2762-6a77-11d0-a535-00c04fd7d062}';
IID_IAutoComplete2 = '{EAC04BC0-3791-11d2-BB95-0060977B464C}';
CLSID_AutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
type
IAutoComplete = interface(IUnknown)
[IID_IAutoComplete]
function Init(hwndEdit: HWND; punkACL: IUnknown; pwszRegKeyPath: PWideChar;
pwszQuickComplete: PWideChar): HResult; stdcall;
function Enable(fEnable: Boolean): HResult; stdcall;
end;
IAutoComplete2 = interface(IAutoComplete)
[IID_IAutoComplete2]
function SetOptions(dwFlag: DWORD): HResult; stdcall;
function GetOptions(out dwFlag: DWORD): HResult; stdcall;
end;
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
private
FAutoComplete: IAutoComplete;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TEnumString }
type
TEnumString = class(TInterfacedObject, IEnumString)
private
FStrings: TStrings;
FCurrIndex: integer;
public
//IEnumString
function Next(celt: Longint; out elt;
pceltFetched: PLongint): HResult; stdcall;
function Skip(celt: Longint): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out enm: IEnumString): HResult; stdcall;
//VCL
constructor Create(AStrings: TStrings; AIndex: Integer = 0);
end;
constructor TEnumString.Create(AStrings: TStrings; AIndex: Integer = 0);
begin
inherited Create;
FStrings := AStrings;
FCurrIndex := AIndex;
end;
function TEnumString.Clone(out enm: IEnumString): HResult;
begin
enm := TEnumString.Create(FStrings, FCurrIndex);
Result := S_OK;
end;
function TEnumString.Next(celt: Integer; out elt;
pceltFetched: PLongint): HResult;
type
TPointerList = array[0..0] of Pointer; //avoid bug of Classes.pas declaration TPointerList = array of Pointer;
var
I: Integer;
wStr: WideString;
begin
I := 0;
while (I < celt) and (FCurrIndex < FStrings.Count) do
begin
wStr := FStrings[FCurrIndex];
TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1));
StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1));
Inc(I);
Inc(FCurrIndex);
end;
if pceltFetched <> nil then
pceltFetched^ := I;
if I = celt then
Result := S_OK
else
Result := S_FALSE;
end;
function TEnumString.Reset: HResult;
begin
FCurrIndex := 0;
Result := S_OK;
end;
function TEnumString.Skip(celt: Integer): HResult;
begin
if (FCurrIndex + celt) <= FStrings.Count then
begin
Inc(FCurrIndex, celt);
Result := S_OK;
end
else
begin
FCurrIndex := FStrings.Count;
Result := S_FALSE;
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
hEditControl: THandle;
LStrings: IUnknown;
LAC2: IAutoComplete2;
begin
with ComboBox1 do
begin
with Items do
begin
BeginUpdate;
try
Clear;
Add('Alpha');
Add('Beta');
Add('Gamma');
Add('Delta');
finally
EndUpdate;
end;
end;
AutoComplete := False;
ItemIndex := 0;
end;
FAutoComplete := CreateComObject(CLSID_AutoComplete) as IAutoComplete;
hEditControl := GetWindow(ComboBox1.Handle, GW_CHILD); // alternatively, use GetComboBoxInfo() to get the Edit HWND
LStrings := TEnumString.Create(ComboBox1.Items);
OleCheck(FAutoComplete.Init(hEditControl, LStrings, nil, nil));
if Supports(FAutoComplete, IAutoComplete2, LAC2) then
begin
// use SetOption as needed...
OleCheck(LAC2.SetOptions(...));
end;
end;
end.
Also, keep in mind that if the TComboBox's HWND is ever recreated at runtime, you will have to create a new IAutoComplete object and call init() on it to provide the new HWND. So you should subclass the TComboBox to handle recreation messages, or better would be to use an interceptor class so you can override the TComboBox.CreateWnd() method directly, eg:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActiveX, ComObj;
const
IID_IAutoComplete = '{00bb2762-6a77-11d0-a535-00c04fd7d062}';
IID_IAutoComplete2 = '{EAC04BC0-3791-11d2-BB95-0060977B464C}';
CLSID_AutoComplete: TGUID = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
type
IAutoComplete = interface(IUnknown)
[IID_IAutoComplete]
function Init(hwndEdit: HWND; punkACL: IUnknown; pwszRegKeyPath: PWideChar;
pwszQuickComplete: PWideChar): HResult; stdcall;
function Enable(fEnable: Boolean): HResult; stdcall;
end;
IAutoComplete2 = interface(IAutoComplete)
[IID_IAutoComplete2]
function SetOptions(dwFlag: DWORD): HResult; stdcall;
function GetOptions(out dwFlag: DWORD): HResult; stdcall;
end;
TComboBox = class(StdCtrls.TComboBox)
private
FAutoComplete: IAutoComplete;
protected
procedure CreateWnd; override;
procedure DestroyWnd; override;
end;
TForm1 = class(TForm)
ComboBox1: TComboBox;
procedure FormCreate(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TEnumString }
type
TEnumString = class(TInterfacedObject, IEnumString)
private
FStrings: TStrings;
FCurrIndex: integer;
public
//IEnumString
function Next(celt: Longint; out elt;
pceltFetched: PLongint): HResult; stdcall;
function Skip(celt: Longint): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out enm: IEnumString): HResult; stdcall;
//VCL
constructor Create(AStrings: TStrings; AIndex: Integer = 0);
end;
constructor TEnumString.Create(AStrings: TStrings; AIndex: Integer = 0);
begin
inherited Create;
FStrings := AStrings;
FCurrIndex := AIndex;
end;
function TEnumString.Clone(out enm: IEnumString): HResult;
begin
enm := TEnumString.Create(FStrings, FCurrIndex);
Result := S_OK;
end;
function TEnumString.Next(celt: Integer; out elt;
pceltFetched: PLongint): HResult;
type
TPointerList = array[0..0] of Pointer; //avoid bug of Classes.pas declaration TPointerList = array of Pointer;
var
I: Integer;
wStr: WideString;
begin
I := 0;
while (I < celt) and (FCurrIndex < FStrings.Count) do
begin
wStr := FStrings[FCurrIndex];
TPointerList(elt)[I] := CoTaskMemAlloc(2 * (Length(wStr) + 1));
StringToWideChar(wStr, TPointerList(elt)[I], 2 * (Length(wStr) + 1));
Inc(I);
Inc(FCurrIndex);
end;
if pceltFetched <> nil then
pceltFetched^ := I;
if I = celt then
Result := S_OK
else
Result := S_FALSE;
end;
function TEnumString.Reset: HResult;
begin
FCurrIndex := 0;
Result := S_OK;
end;
function TEnumString.Skip(celt: Integer): HResult;
begin
if (FCurrIndex + celt) <= FStrings.Count then
begin
Inc(FCurrIndex, celt);
Result := S_OK;
end
else
begin
FCurrIndex := FStrings.Count;
Result := S_FALSE;
end;
end;
{ TComboBox }
procedure TComboBox.CreateWnd;
var
hEditControl: THandle;
LStrings: IUnknown;
LAC2: IAutoComplete2;
begin
inherited;
FAutoComplete := CreateComObject(CLSID_AutoComplete) as IAutoComplete;
hEditControl := GetWindow(Handle, GW_CHILD); // alternatively, use GetComboBoxInfo() to get the Edit HWND
LStrings := TEnumString.Create(Items);
OleCheck(FAutoComplete.Init(hEditControl, LStrings, nil, nil));
if Supports(FAutoComplete, IAutoComplete2, LAC2) then
begin
// use SetOption as needed...
OleCheck(LAC2.SetOptions(...));
end;
end;
procedure TComboBox.DestroyWnd;
begin
FAutoComplete := nil;
inherited;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
with ComboBox1 do
begin
with Items do
begin
BeginUpdate;
try
Clear;
Add('Alpha');
Add('Beta');
Add('Gamma');
Add('Delta');
finally
EndUpdate;
end;
end;
AutoComplete := False;
ItemIndex := 0;
end;
end;
end.