delphi – 如何检查当前是否显示了SHAutoComplete()列表框？

>在使用Windows XP 64的PC上,当列表被删除时,对话框将关闭
>在VMware虚拟机中的Windows XP Pro上,对话框也会关闭

但

>在我的Windows 7笔记本电脑上,对话框没有关闭
>在VMware虚拟机中的Windows 2000 Pro上,对话框不会关闭

由于这是如此不稳定,我选择编写一个小组件,即使操作系统不提供它也会强制执行正确的行为.

该组件可以像这样使用：

procedure TForm2.FormCreate(Sender: TObject);
const
  SHACF_FILESYS_DIRS = $00000020;
begin
  SHAutoComplete(Edit1.Handle,SHACF_FILESYS_DIRS or SHACF_USETAB);
  fAutoSuggestDropdownChecker := TAutoSuggestDropdownChecker.Create(Self);
end;

procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then begin
    if not fAutoSuggestDropdownChecker.DroppedDown then
      ModalResult := mrCancel;
  end;
end;

但重要的是取消按钮没有设置取消属性.

组件本身通过挂钩到应用程序消息处理并使用当前线程的窗口枚举来检查具有“Auto-Suggest Dropdown”类名称的可见窗口.如果存在且可见,则自动完成列表将被删除.

unit uAutoSuggestDropdownCheck;

interface

uses
  Windows,Classes,Messages,Forms;

type
  TAutoSuggestDropdownChecker = class(TComponent)
  private
    fDroppedDown: boolean;
    fSaveMessageEvent: TMessageEvent;
    procedure AppOnMessage(var AMsg: TMsg; var AHandled: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property DroppedDown: boolean read fDroppedDown;
  end;

implementation

////////////////////////////////////////////////////////////////////////////////

function EnumThreadWindowsProc(AWnd: HWND; AParam: LPARAM): BOOL; stdcall;
var
  WndClassName: string;
  FoundAndVisiblePtr: PInteger;
begin
  SetLength(WndClassName,1024);
  GetClassName(AWnd,PChar(WndClassName),Length(WndClassName));
  WndClassName := PChar(WndClassName);
  if WndClassName = 'Auto-Suggest Dropdown' then begin
    FoundAndVisiblePtr := PInteger(AParam);
    FoundAndVisiblePtr^ := Ord(IsWindowVisible(AWnd));
    Result := False;
  end else
    Result := True;
end;

function IsAutoSuggestDropdownVisible: boolean;
var
  FoundAndVisible: integer;
begin
  FoundAndVisible := 0;
  EnumThreadWindows(GetCurrentThreadId,@EnumThreadWindowsProc,LParam(@FoundAndVisible));
  Result := FoundAndVisible > 0;
end;

////////////////////////////////////////////////////////////////////////////////
// TAutoSuggestDropdownChecker
////////////////////////////////////////////////////////////////////////////////

constructor TAutoSuggestDropdownChecker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fSaveMessageEvent := Application.OnMessage;
  Application.OnMessage := AppOnMessage;
end;

destructor TAutoSuggestDropdownChecker.Destroy;
begin
  if (TMethod(fSaveMessageEvent).Code = TMethod(Application.OnMessage).Code)
    and (TMethod(fSaveMessageEvent).Data = TMethod(Application.OnMessage).Data)
  then begin
    Application.OnMessage := fSaveMessageEvent;
  end;
  fSaveMessageEvent := nil;
  inherited;
end;

procedure TAutoSuggestDropdownChecker.AppOnMessage(var AMsg: TMsg;
  var AHandled: Boolean);
begin
  if ((AMsg.message >= WM_KEYFIRST) and (AMsg.message <= WM_KEYLAST))
    or ((AMsg.message >= WM_MOUSEFIRST) and (AMsg.message <= WM_MOUSELAST))
    or (AMsg.message = WM_CANCELMODE)
  then
    fDroppedDown := IsAutoSuggestDropdownVisible
end;

end.

这里发布的代码只是概念验证,但可以作为那些在同一问题上挣扎的人的起点.