Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can I check whether a SHAutoComplete( ) list box is currently shown?

I'm using the SHAutoComplete() function from the Shell Lightweight Utility Functions library to enable path auto completion for edit fields in a modal dialog.

The dialog should close when the Esc key is pressed, but only if auto completion is not active.

How can I check whether a completion list is currently shown for the focused edit control?

Edit:

I'm using Delphi 2009 on Windows XP 64. The code posted by David

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

does not work for me - the dialog gets closed.

like image 507
mghie Avatar asked Feb 10 '12 07:02

mghie


2 Answers

I have tried on several systems, with strange results:

  • on my PC with Windows XP 64 the dialog closes while the list is dropped down
  • on Windows XP Pro in a VMware virtual machine the dialog closes too

but

  • on my laptop with Windows 7 the dialog does not close
  • on Windows 2000 Pro in a VMware virtual machine the dialog does not close

Since this is so erratic I chose to write a small component that forces the correct behaviour even if the OS doesn't provide it.


The component can be used like this:

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;

but it is important that the Cancel button does not have the Cancel property set.

The component itself works by hooking into application message handling and using window enumeration for the current thread to check for a visible window with the "Auto-Suggest Dropdown" class name. If this exists and is visible then the auto completion list is dropped down.

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.

The code as posted here is only proof-of-concept but could serve as starting point for those struggling with the same problem.

like image 190
mghie Avatar answered Sep 24 '22 16:09

mghie


I can't reproduce your problem. The following OnKeyDown handler, combined with KeyPreview := True gives the desired behaviour in an otherwise empty form.

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

I guess there is something else in your form that is closing the dialog.

like image 36
David Heffernan Avatar answered Sep 22 '22 16:09

David Heffernan