|
:: 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
begin
Hint.Visible := False;
Hint.Caption := Filter + ' (' + VisibleItemsCount.ToString + ')';
Hint.Visible := True;
end
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(FKeyboardHook, 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;
|
.: Пример к данной статье :.
|
|
При использовании материала - ссылка на сайт обязательна
|
|
