Практика
Продвинутая навигации в PopupMenu

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика


Длинное выпадающее меню, не влезающее в экран это, безусловно, зло. Явление это достаточно редкое (субъективно, конечно, сужу исключительно по личному опыту), встречающееся, как правило, в больших корпоративных системах. Такие системы могут иметь довольно развитый функционал – сервисы, отчеты и т.п. (речь может идти о сотнях, и даже о тысячах), и все это представлено в виде сущностей в базе данных. А чтобы сотрудник мог всем этим добром воспользоваться, динамически строятся запредельно длинные меню.

Рядовым пользователям, как правило, с подобным сталкиваться не приходится, так как их возможности ограничиваются функциональными ролями, соответствующими должностным обязанностям. Совсем другое дело – разработчики (они же тестировщики), им доступно все богатство функциональных возможностей системы. Они по многу раз в день перемещаются по огромным спискам меню вверх и вниз в поисках нужного пункта (например, при обращении пользователя, у которого не работает тот или иной сервис).

Конечно, разработчики облегчают себе жизнь, оптимизируя запуск требуемого функционала. Например, создают секретную форму (не доступную рядовым пользователям и запускаемую хитрой комбинацией клавиш), из которой запускают требуемый функционал по уникальному идентификатору. В рамках данной статьи я хочу рассмотреть пару решений, оптимизирующих запуск требуемого функционала непосредственно из меню.

Первое – перемещение по пунктам меню с помощью колесика мыши (в случае, если мышь оборудована инерционным колесиком, скорость навигации увеличивается многократно). Второе – динамическая фильтрация пунктов меню по их заголовку (в этом случае огромный список может сократиться до вполне приемлемых размеров, и найти требуемый пункт станет совсем просто).

Первый пункт легко реализуем как для MainMenu, так и для PopupMenu, второй пункт мне удалось сделать только для PopupMenu (причины этого будут описаны дальше). Впрочем, для выполнения моей задачи этого вполне достаточно (интерфейс приложения, для которого писалось данное решение, построен на PopupMenu).

Но для начала наведем немного красоты. Если количество пунктов в меню больше, чем может уместиться в промежутке между курсором и низом экрана, меню открывается выше курсора.


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

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const
  ArrowScrollCount = 2;
var
  p: TPoint;
  Info: TMenuInfo;
  WorkArea,
  MenuItemCount,
  MenuItemHeight: Integer;
begin
  if Button = mbRight then
  begin
    p := ClientToScreen(Point(X, Y));

    MenuItemHeight := GetSystemMetrics(SM_CYMENU);
    WorkArea := (Screen.WorkAreaHeight - p.Y) - ((Screen.WorkAreaHeight - p.Y) mod MenuItemHeight);
    MenuItemCount := (WorkArea div MenuItemHeight) - ArrowScrollCount;

    FillChar(Info, SizeOf(Info), 0);
    Info.cbSize := SizeOf(Info);
    Info.fMask := MIM_MAXHEIGHT;
    if GetMenuInfo(PopupMenu1.Handle, Info) then
    begin
      Info.cyMax := 0;
      SetMenuInfo(PopupMenu1.Handle, Info);

      if PopupMenu1.Items.Count >= MenuItemCount then
      begin
        Info.cyMax := (MenuItemCount + ArrowScrollCount) * MenuItemHeight;
        SetMenuInfo(PopupMenu1.Handle, Info);
      end;

      TrackPopupMenu(PopupMenu1.Handle, TPM_TOPALIGN or TPM_LEFTBUTTON,
        p.X, p.Y, 0, PopupList.Window, nil);
    end;
  end;
end;

Все достаточно просто. Определяем позицию курсора и рассчитываем, сколько пунктов меню может поместиться между ним и низом экрана (с учетом двух полос прокрутки сверху и снизу меню). Если пунктов больше рассчитанного количества, уменьшаем высоту меню.


У такого способа открытия меню есть один недостаток. Поскольку оно не привязано к форме (через свойство PopupMenu), не будут срабатывать горячие клавиши, назначенные для его пунктов. Это решается использованием компонента ApplicationEvents, в его обработчике OnShortCut напишем следующее:

procedure TForm1.ApplicationEvents1ShortCut(var Msg: TWMKey;
  var Handled: Boolean);
begin
  if Screen.ActiveForm = Self then
    Handled := PopupMenu1.IsShortCut(Msg);
end;

Событие OnShortCut срабатывает даже в том случае, если в приложении открыта дочерняя форма. Это может стать проблемой, если в дочерней форме определены те же горячие клавиши, что уже имеются в PopupMenu. В этом случае горячие клавиши главной формы будут иметь приоритет при обработке, и перекроют собой аналогичные горячие клавиши дочерней формы. Чтобы этого не происходило, код обработчика события OnShortCut должен срабатывать только тогда, когда главная форма является активной.

Теперь перейдем к реализации задуманного и первым делом добавим возможность навигации по меню с помощью колесика мыши. Идея такова. С помощью хука WH_CALLWNDPROC отслеживаем появление меню, для чего ловим сообщение WM_INITMENUPOPUP. Внутри обработчика ставим низкоуровневый хук на мышь (WH_MOUSE_LL) для отлова сообщения WM_MOUSEWHEEL. И наконец, перехватив это сообщение, уведомляем меню о нажатии клавиши VK_UP или VK_DOWN.

Для того чтобы отправить сообщение меню нужен Handle окна, но свойство Handle не то, что сможет нам помочь в данном случае. Перед отображением меню на экране система создает невидимое окно с классом '#32768', которое и отвечает за отображение меню. Для получения HWND воспользуемся функцией FindWindowEx и будем искать окно по имени его класса.

constructor TPopupEx.Create;
begin
  {...}

  FWndProcHook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProcHook, 0, GetCurrentThreadId);
end;

class function TPopupEx.CallWndProcHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LongInt;
{...}
begin
  if Code = HC_ACTION then
  begin
    Msg := PCWPStruct(lParam)^;

    case Msg.message of
      WM_INITMENUPOPUP: begin
        {...}

        if FMouseHook = 0 then
          FMouseHook := SetWindowsHookEx(WH_MOUSE_LL, @CallMouseHook, HInstance, 0);
      end;
      WM_UNINITMENUPOPUP: begin
        {...}

        if FMouseHook > 0 then
        begin
          UnHookWindowsHookEx(FMouseHook);
          FMouseHook := 0;
        end;
      end;

      {...}
    end;
  end;

  Result := CallNextHookEx(FWndProcHook, Code, wParam, lParam);
end;

class function TPopupEx.CallMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LongInt; stdcall;
var
  Menu: HWND;
  MenuRect: TRect;
begin
   if Code = HC_ACTION then
   begin
     Menu := FindWindowEx(0, 0, MakeIntAtom($8000), nil);
     if Menu > 0 then
       case wParam of
         WM_MOUSEWHEEL: begin
           if _PopupEx.ClipRect then
           begin
             GetWindowRect(Menu, MenuRect);
             InflateRect(MenuRect, 20, 20);
             if not PtInRect(MenuRect, PMouseHookStructEx(lParam)^.MouseHookStruct.pt) then
             begin
               Result := CallNextHookEx(FMouseHook, Code, wParam, lParam);
               Exit;
             end;
           end;

           if SmallInt(HiWord(PEventMsg(lParam)^.paramH)) > 0 then
             PostMessage(Menu, WM_KEYDOWN, VK_UP, 0)
           else if SmallInt(HiWord(PEventMsg(lParam)^.paramH)) < 0 then
             PostMessage(Menu, WM_KEYDOWN, VK_DOWN, 0);
         end;
       end;
   end;

   Result := CallNextHookEx(FMouseHook, Code, wParam, lParam);
end;

Обратите внимание на свойство ClipRect. Если оно установлено в True, то область, в которой меню реагирует на сообщения от колеса мыши, ограничивается размерами меню. Это не очень удобно, так как малейшее движение мыши во время скролла приведёт к выбору элемента под курсором, что может сбивать, и даже раздражать. Поэтому область, в которой меню реагирует на скролл, немного увеличивается.

Теперь перейдем к реализации динамической фильтрации меню. Нам нужно отслеживать вводимый пользователем текст, для чего мы будем перехватывать сообщение WM_CHAR внутри хука WH_CALLWNDPROC. Также предоставим пользователю возможность посимвольного удаления введенного текста клавишей Backspace и полной очистки фильтра клавишей Delete, для этого нам потребуется низкоуровневый хук на клавиатуру WH_KEYBOARD_LL.

Для информативности будем отображать во всплывающей подсказке количество отфильтрованных пунктов.

type
  {...}

  TMenuItem = class(Vcl.Menus.TMenuItem)
  protected
    procedure MenuChanged(Rebuild: Boolean); override;
  end;

implementation

constructor TPopupEx.Create;
begin
  FWindowsVersion := GetWindowsVersion;
  FWindowsMajorVersion := HiByte(FWindowsVersion);
  FWindowsMinorVersion := LoByte(FWindowsVersion);

  {...}
end;

function TPopupEx.ApplyFilter(const Filter: string): Cardinal;
var
  i: Integer;
  Match: Boolean;
begin
  Result := 0;

  if Assigned(FMenu) then
    for i := 0 to FMenu.Items.Count-1 do
    begin
      if (GetKeyState(VK_SCROLL) and 1 ) = 0 then
        Match := Pos(AnsiLowerCase(FFilter), AnsiLowerCase(StringReplace(FMenu.Items[i].Caption, '&', '', []))) > 0
      else
        if StrToIntDef(Filter, 0) = 0 then
          Match := False
        else
          Match := Pos(FFilter, IntToStr(FMenu.Items[i].Tag)) > 0;


      FMenu.Items[i].Visible := Match or (FFilter = '');

      if FMenu.Items[i].Visible then
        Inc(Result);
    end;
end;

function TPopupEx.NeedRestore(const VisibleItemsCount: Cardinal): Boolean;
begin
  Result := False;
  if Assigned(FMenu) then
    Result := (VisibleItemsCount = 0) or (VisibleItemsCount = FMenu.Items.Count);
end;

procedure TPopupEx.RestoreMenu;
var
  i: Integer;
begin
  if Assigned(FMenu) then
  begin
    FFilter := '';
    for i := 0 to FMenu.Items.Count-1 do
      FMenu.Items[i].Visible := True;
  end;
end;

class function TPopupEx.CallWndProcHook(Code: Integer; wParam: WPARAM;
  lParam: LPARAM): LongInt;
var
  {...}
begin
  {...}

    case Msg.message of
      WM_INITMENUPOPUP: begin
        with _PopupEx do
        begin
          {...}

          for i := 0 to Screen.ActiveForm.ComponentCount-1 do
            if Screen.ActiveForm.Components[i] is TPopupMenu then
              if TPopupMenu(Screen.ActiveForm.Components[i]).Handle = Msg.wParam then
              begin
                Menu := TPopupMenu(Screen.ActiveForm.Components[i]);
                Break;
              end;

          if Assigned(Menu) then
          begin
            if WindowsMajorVersion < 10 then
            begin
              GetWindowRect(FindWindowEx(0, 0, MakeIntAtom($8000), nil), r);
              MenuRect := r;
            end
            else
              GetCursorPos(r.TopLeft);

            {...}

            if FKeyboardHook = 0 then
              FKeyboardHook := SetWindowsHookEx(WH_KEYBOARD_LL, @CallKeyboardHook, HInstance, 0);
          end;

          {...}
        end;
      end;
      WM_UNINITMENUPOPUP: begin
        with _PopupEx do
        begin
          if Assigned(Menu) then
          begin
            Hint.ReleaseHandle;
            Hint.Free;

            RestoreMenu;
            Menu.Popup(-2000, Screen.Height + 1000);

            Menu := nil;
          end;

          if FKeyboardHook > 0 then
          begin
            UnHookWindowsHookEx(FKeyboardHook);
            FKeyboardHook := 0;
          end;

          {...}
        end;
      end;
      WM_CHAR: begin
        if Assigned(_PopupEx.Menu) and (Msg.wParam > 31) then
        begin
          if FindWindowEx(0, 0, MakeIntAtom($8000), nil) > 0 then
          begin
            with _PopupEx do
            begin
              Filter := Filter + Chr(Msg.wParam);
              VisibleItemsCount := ApplyFilter(Filter);

              if NeedRestore(VisibleItemsCount) then
              begin
                Hint.Visible := False;
                RestoreMenu;
              end
              else
              begin
                Hint.Visible := False;
                Hint.Caption := Filter + ' (' + VisibleItemsCount.ToString + ')';
                Hint.Visible := True;
              end;

              Menu.Popup(MenuRect.Left, MenuRect.Top);
            end;

            Result := 1;
            Exit;
          end;
        end;
    end;

  {...}
end;

class function TPopupEx.CallKeyboardHook(Code: Integer; wParam: WPARAM;
  lParam: LPARAM): LongInt;
var
  Msg: TKbdDllHookStrukt;
  VisibleItemsCount: Cardinal;
begin
  if (Code = HC_ACTION) and (wParam = WM_KEYDOWN) and (lParam shr 31 = 0) then
  begin
    Msg := PKbdDllHookStrukt(lParam)^;

    if FindWindowEx(0, 0, MakeIntAtom($8000), nil) > 0 then
      case Msg.vkCode of
        VK_BACK: begin
          with _PopupEx do
          begin
            if Assigned(Menu) and (Filter <> '') then
            begin
              Filter := Copy(Filter, 1, Length(Filter)-1);
              VisibleItemsCount := ApplyFilter(Filter);

              if not NeedRestore(VisibleItemsCount) then
                Hint.Caption := Filter + ' (' + VisibleItemsCount.ToString + ')'
              else
                Hint.Visible := False;

              Menu.Popup(MenuRect.Left, MenuRect.Top);
            end;
          end;
        end;
        VK_DELETE:
          with _PopupEx do
            if Assigned(Menu) and (Filter <> '') then
            begin
              Filter := '';
              ApplyFilter(Filter);
              Hint.Visible := False;
              Menu.Popup(MenuRect.Left, MenuRect.Top);
            end;
      end;
  end;

  Result := CallNextHookEx(FWndProcHook, Code, wParam, lParam);
end;

function TPopupEx.GetWindowsVersion: Word;
asm
  {$IFDEF WIN32}
  mov edx, fs:[30h]
  mov eax, [edx+0A4h]
  shl eax, 8
  mov  al, [edx+0A8h]
  {$ELSE IFDEF WIN64}
  mov rdx, qword ptr GS:[abs $60]
  mov eax, [rdx+118h]
  shl eax, 8
  mov  al, [rdx+11Ch]
  {$ENDIF}
end;

{ TMenuItem }

{$IFDEF MENUITEMFIX}
procedure TMenuItem.MenuChanged(Rebuild: Boolean);
begin
  inherited MenuChanged(False);
end;
{$ENDIF}

Кода много, попробуем разобраться в основных моментах. Ключевой момент – перекрытие метода TMenuItem.MenuChanged. Каждый раз, когда скрывается/показывается элемент меню, происходит вызов метода MenuChanged с аргументом True.

procedure TMenuItem.SetVisible(Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    MenuChanged(True);
  end;
end;

Это, в свою очередь, приводит к вызову метода RebuildHandle, который полностью перестраивает меню (уничтожает все элементы, а затем заново создает их. Зачем?..). Таким образом, перекрытие метода MenuChanged избавляет нас от раздражающего мерцания при манипуляциях с видимостью элементов меню. Однако после того как нужные элементы показаны а ненужные скрыты, меню требуется пересоздать. Это делается с помощью вызова метода Popup, который присутствует в PopupMenu (именно по этой причине я не добавил поддержку фильтрации в MainMenu, я не нашел в нем аналогичного метода).

Для того чтобы эта магия заработала, важно включить модуль PopupEx в секцию uses после модуля Vcl.Menus, в противном случае не сработает перекрытие метода TMenuItem.MenuChanged. Попробуйте в прилагаемом к статье примере удалить модуль PopupEx из uses и посмотрите на то, как бешено будет мерцать меню при перестроении.

Чтобы отобразить подсказку над меню нужно получить его координаты. Первоначально, когда я писал это решение, я тестировал его в Windows 7, в которой координаты окна (того самого, с классом '#32768') совпадают с координатами, в которых отображается меню (к слову, его размеры равны 100 на 100 пикселей). Впоследствии, тестируя код в Windows 10 обнаружилось, что окно стало создаваться в начале экранных координат, и для расчета координат всплывающей подсказки пришлось использовать координаты курсора.

Конечно, можно было бы во всех версиях Windows использовать координаты курсора, но я решил оставить разные подходы в качестве напоминания (шпаргалки самому себе) о разном поведении окна меню в разных версиях системы (этим объясняется наличие функции GetWindowsVersion).

Может случиться так, что пользователь не помнит название нужного сервиса (которое записывается в заголовок пункта меню), но помнит его уникальный идентификатор (который записывается в свойство Tag). Механизм фильтрации предусматривает возможность выбора критерия для поиска, переключение осуществляется включением/выключением кнопки Scroll Lock.

Чтобы при создании пунктов меню им не незначались клавиши акселераторы нужно записать пустую строку в глобальную переменную ValidMenuHotkeys. Однако это не дает полной гарантии, и в процессе фильтрации событио OnClick может срабатывать в случае, когда отобранных пунктов остается немного. В этой ситуации спасает добавление символа неразрывного пробела (с кодом 160) в начало заголовка.

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  MenuItem: TMenuItem;
begin
  ValidMenuHotkeys := '';

  for i := 0 to Length(Services)-1 do
  begin
    MenuItem := TMenuItem.Create(PopupMenu1);
    MenuItem.Tag := i+1;
    MenuItem.Caption := #160 + Services[i].Caption;
    {...}
  end;
end;

.: Пример к данной статье :.


При использовании материала - ссылка на сайт обязательна