delphi - 如何将 IAutoComplete 与 TStringsAdapter 一起使用？

标签 delphi winapi autocomplete com

在此SO post ，建议将IAutoComplete与TStringsAdapter一起使用来实现自动完成。以下代码尝试遵循建议，但无法在没有编译和运行时异常的情况下启用自动完成功能提示接口(interface)不匹配/不一致..。您能帮忙评论一下根本原因和解决方法吗？

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 配合使用

最佳答案

Could you help to comment about the underlying reason and the work around ?

代码失败的原因是 TStringsAdapters 构造函数尝试加载 StdVCL 类型库并失败，引发“库未注册”错误:

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 事件中构造，该事件在表单的构造函数退出后触发，因此该异常不会中止构造或终止进程，但它确实到达了显示错误弹出消息的默认异常处理程序。此外，异常(exception)是绕过对 FAutoComplete.Init() 的调用，因此不会为 ComboBox 创建或注册任何枚举器。

即使您已将 StdVCL 添加到您的 use 子句中，但这还不足以在您的应用运行的计算机上注册 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.

关于delphi - 如何将 IAutoComplete 与 TStringsAdapter 一起使用？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/34317985/

上一篇：spring - DefaultJmsListenerContainerFactory 和并发连接未关闭

下一篇：java - 如何在 selenium 的 select2 下拉列表中选择动态值

相关文章：

C++ 屏幕截图 - 如何读取位图？

c++ - 使用 CoInitialize 和 CoUninitialize 引发 C++ 异常

ios - 将谷歌自动完成限制为仅限城市和国家 iOS Swift

delphi - New 和 Dispose 内部做什么？

multithreading - Delphi异常处理，使用E : Exception or ExceptObject

sql - 如何从 ADO 查询中获取记录数？

winapi - 汇编器 : Getting Win32's WinMain on-stack parameters

javascript - 清除自动完成数据 Jquery

jquery - 带有自定义滚动条的自动完成 jquery UI 插件

delphi - COM+函数参数的最大数量限制

©2024 IT工具网  联系我们