如何将IAutoComplete与TStringsAdapter一起使用？

Question

在此SO post中，建议将IAutoComplete与TStringsAdapter一起使用以实现自动完成。以下代码尝试遵循该建议，但无法启用自动完成功能而无需编译＆amp;运行时异常抱怨不匹配/不一致的接口.. 。你能帮忙评论潜在的原因和解决方法吗？

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.

请注意，相关的SO帖子（here和here）使用TEnumString手动实现IEnumString，而不是使用TStringsAdapter来处理IAutoComplete

Answer 1

  

你能帮忙评论潜在的原因和解决方法吗？

代码失败的原因是因为TStringsAdapters构造函数尝试加载StdVCL类型库并失败，因此引发了未注册的＆＃34;库＆＃34;错误：

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;

TStringsAdapter对象正在以OnCreate事件的形式构建，该事件在表单构造函数退出后触发，因此异常不会中止构造或终止该进程，但它确实到达一个显示错误弹出消息的默认异常处理程序。此外，例外是绕过对FAutoComplete.Init()的调用，因此没有为ComboBox创建或注册枚举器。

即使您已将StdVCL添加到uses子句中，但这还不足以让您的应用运行的计算机上注册StdVCL类型库。您必须在应用程序的安装设置中分发和注册该类型库。

解决方法是使用TEnumString实现，它只是直接枚举TStrings值，从而避免了这一要求。除了运行时开销稍微少一些，然后使用TStringsAdapter（其_NewEnum()方法创建一个单独的TStringsEnumerator对象来执行实际的枚举，所以实际上你创建的是2个对象，而不是1），但代价是必须编写更多代码来实现它，例如：

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.

另外，请记住，如果在运行时重新创建TComboBox的HWND，则必须创建一个新的IAutoComplete对象并在其上调用init()提供新的HWND。所以你应该继承TComboBox来处理重新创建消息，或者更好的方法是使用拦截器类，这样你就可以直接覆盖TComboBox.CreateWnd()方法，例如：

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.