Как я могу проверить, отображается ли в настоящий момент список со списком SHAutoComplete ()?

Question

Я использую функцию SHAutoComplete() из библиотеки Shell Lightweight Utility Functions, чтобы включить автозаполнение пути для полей редактирования в модальном диалоге.

Диалог должен закрыться, когда Esc клавиша нажата, но только если автозаполнение не активно.

Как проверить, отображается ли в настоящее время список завершения для элемента управления с фокусом редактирования?

Редактировать:

Я использую Delphi 2009 на Windows XP 64. Код, отправленный Дэвидом

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

, не работает для меня - диалог закрывается.

Answer 1

Я пробовал на нескольких системах со странными результатами:

• на моем ПК с Windows XP 64 диалоговое окно закрывается, а список выпадает из списка
• в Windows XP Pro вна виртуальной машине VMware диалоговое окно тоже закрывается

, но

• на моем ноутбуке с Windows 7 диалоговое окно не закрывается
• в Windows 2000 Pro вВиртуальная машина VMware: диалоговое окно не закрывается

Поскольку это настолько странно, я решил написать небольшой компонент, обеспечивающий правильное поведение, даже если ОС не обеспечивает его.

Компонент может использоваться следующим образом:

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;

, но важно, чтобы у кнопки Отмена не было установлено свойство Cancel.

Сам компонент работает путем перехватав обработку сообщений приложения и использование перечисления окон для текущего потока, чтобы проверить наличие видимого окна с именем класса «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.

Приведенный здесь код является лишь проверкой концепции, но может служить отправной точкой для тех, кто борется с той же проблемой.

Answer 2

Я не могу воспроизвести вашу проблему. Следующий обработчик OnKeyDown в сочетании с KeyPreview := True дает желаемое поведение в пустой форме.

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

Полагаю, в вашей форме есть еще что-то, что закрывает диалог.