Firemonkey. От простого к сложному #6. Class Helper для элементов меню.

Наконец-то свершилось — вышел Update 4 для Delphi XE2. Надо сказать, список исправленных/добавленных свойств и методов для FireMonkey в итоге оказался повнушительнее, чем тот, который был при первом упоминании об Update 4 в этом блоге.  Ну что ж, отлично! Можно продолжать список постов про FireMonkey уже с учётом последних нововведений и исправлений. Однако, несмотря на то, что в списке исправлений есть упоминание про PopupMenu, всё же «непонятки» по работе с этим компонентом остались. Может я чего и не понял и поспешил набросать class helper, который будет рассмотрен в этой статье, но тем не менее суть своих (и не только своих) проблем при работе с PopupMenu я изложу в начале, не тратя время на рассмотрение свойств и методов PopupMenu и его элементов, которые работают корректно с любой точки зрения. Итак, основной вопрос, с которого и началась работа над class helper’ом — как вставлять/удалять дочерние элементы? Мы ведь уже в курсе, что каждый компонент FireMonkey — это контейнер, который может содержать другие элементы? Так почему бы не обеспечить работу с элементами меню в runtime? Ok, создадим простенький проект FireMonkey HD Application. На главную форму кинем кнопку TButton и TPopupMenu. У кнопки в свойстве PopupMenu укажем наше меню, а в само меню добавим один иле несколько элементов. Теперь попробуем добавить для первого элемента меню новый дочерний элемент. Сделать это довольно просто, например, так:

procedure TForm1.Button1Click(Sender: TObject);
var NewItem: TMenuItem;
begin
 NewItem := TMenuitem.Create(PopupMenu1);
 NewItem.Text := 'My New Item';
 NewItem.Parent := MenuItem1;
 MenuItem1.AddObject(NewItem);
end;

Теперь можно запустить приложение ткнуть левой кнопкой мыши по кнопке, а затем вызвать PopupMenu и убедиться, что элемент добавился и вообще меню отрисовалось правильно: Теперь попробуем таким же маневром удалить этот дочерний элемент из меню…Даже так (чтобы было по-проще) — попробуем удалить все дочерние элементы для MenuItem1. Следуя простой логике можно предположить, что раз мы делаем так:

MenuItem1.AddObject(NewItem);

То вызов обратного метода — RemoveObject()для каждого дочернего элемента приведет к удалению оного и меню примет свой первоначальный вид (уберется стрелочка у первого элемента и, соответственно, удалиться дочерний элемент). Проверяем нашу гипотезу:

procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
for i := MenuItem1.ChildrenCount - 1 downto 0 do
   MenuItem1.RemoveObject(MenuItem1.Children[i]);
end;

Пробуем взлететь. И получаем вот такую штуку вместо результата: Вместо удаления дочернего элемента меню мы удалили все элементы стиля :). Ответ на риторический вопрос из трех букв — «WTF?» — дал следующий результат — дочерний элемент меню добавляется в поле FContent у TMenuItem:

procedure TMenuItem.AddObject(AObject: TFmxObject);
begin
  if (FContent <> nil) and (AObject is TMenuItem) then
  begin
    TMenuItem(AObject).Locked := True;
    FContent.AddObject(AObject);
    if IsHandleValid(Handle) then
      Platform.UpdateMenuItem(Self)
  end
  else
    inherited;
end;

И это, в принципе, согласуется с идеей FireMonkey — напрямую в стиль мы не можем добавить дочерний элемент, не изменив при этом внешний вид компонента, а вот использовать поле класса для хранения такой информации — вполне можем, что и делаем в TMenuItem.AddObject. Беда только в том, что до FContent просто так не докапаться — нет у нас в распоряжении такого свойства. Аналогичная ситуация (что, опять же, вполне понятно) будет наблюдаться и в том случае, если мы решим воспользоваться методом DeleteChildren. Только в этом случае мы ещё до кучи можем отхватить и довольно неприятный AV, который получается после нескольких вызовов подряд DeleteChildren. «Нескольких» потому что AV может выскочить как на второй раз вызова DeleteChildren, так и на десятый…Как вариант, можно было бы организовать поиск FContent:TContent в списке дочерних элементов и работать непосредственно с ним. Но в последнее время я стал «более лучше одеваться«(с) оценивать затраты времени на решение задачи и такая оценка показала — удобнее будет написать небольшой helper для TMenuItemи потом его использовать для своих нужд, нежели каждый раз искать что-то в пунктах меню.

Class Helper для TMenuItem

Памятуя о том, что далеко не все из нас планомерно переходят с одной версии Delphi на другую и не знают о всех нововведениях и это, ИМХО, нормально, вначале я дам пару ссылок на информацию о хэлперах в Delphi, что бы те, кто только подключился к разработке на Delphi XE2 смогли быстренько изучить эту полезную фичу.

• Первая ссылка — Help Delphi  — «Class and Record Helpers»
• Вторая ссылка — небольшой примерчик по использованию хэлпера для работы с Synapse.

Теперь, что касается хэлпера для TMenuItem. Здесь я решил реализовать следующие методы:

1. Удаление всех дочерних элементов для пункта меню
2. Удаление дочернего элемента по его индексу в списке
3. Удаление дочернего элемента по имени (значению свойства Text)
4. Перечисление всех дочерних пунктов меню для заданного пункта
5. Пара методов для удобного добавления новых пунктов меню
6. Пара методов для получения подпунктов меню

Сейчас я не буду расписывать исходный код каждого из методов в хэлпере, а расскажу об их назначении и приведу небольшой примерчик использования class helper для TMenuItem в программе. Итак, хэлпер имеет следующее описание:

type
  TMenuItemHelper = class helper for TMenuItem
    procedure UpdateItem; 
    procedure DeleteChildrenItems; //удаление всех подпунктов элемента меню
    procedure ChildNames(ANames: TStrings);//перечисление всех названий подпунктов
    procedure DeleteChildByName(const AChildName: string;
      DeleteAll: boolean = True); //удаление подпунктов по их названию. DeleteAll = True - удаление всех подпунктов с заданным в AChildName названием
    procedure DeleteChildByIndex(AChildIndex: integer);//удаление подпункта по его индексу
    function AddChildrenItem(AChild: TMenuItem):integer; overload;//добавление подупункта
    function AddChildrenItem(const AChildName: string):integer; overload;//добавление подупункта
    function IndexOf(const AChildName: string): integer;//получение первого индекса подпункта с названием AChilName
    function GetChildItem(AIndex:Integer):TMenuItem; //получение подпункта по его индексу
    function ChidItemsCount: integer; //получение количества подпунктов
  end;

Теперь небольшой примерчик использования хэлпера в программе. Примеры добавления элементов меню:

procedure TForm1.Button1Click(Sender: TObject);
var NewItem: TMenuItem;
    i:integer;
begin
  //добавили подпункт, указав только его название
  i:=MenuItem1.AddChildrenItem('Мой новый элемент');
  //добавление подпункта для элемента, добавленного в предыдущей операции
  NewItem:=TMenuItem.Create(PopupMenu1);
  NewItem.Text:='моЙ ноВый элемеНт';
  MenuItem1.GetChildItem(i).AddChildrenItem(NewItem);
end;

Результат выполнения такого кода: Пример удаления подпунктов меню:

procedure TForm1.Button2Click(Sender: TObject);
begin
  //удаляем только первый подпункт с таким названием
  MenuItem1.DeleteChildByName('мОй НоВыЙ эЛеМеНт', false);
  //удаляем все оставшиеся
  MenuItem1.DeleteChildByName('мОй НоВыЙ эЛеМеНт');
end;

И, наконец, перечисление названий всех подпунктов:

MenuItem1.ChildNames(Memo1.Lines);

Как видите, используется хэлпер довольно просто. Осталось только заметить одну не то фичу, не то не знамо что. Дело в том, что AddObject добавляет дочерние элементы в список по такому принципу: когда список дочерних элементов пуст, то первый элемент, что логично, вставиться в список с нулевым индексом, второй элемент…встанет с индексом 0, а первый добавленный уже будет иметь индекс 1, третий элемент получит индекс 1, а второй — 0, первый — 2 и т.д. То есть сколько бы мы не добавляли подпунктов в меню наш первый добавленный элемент будет находится ниже всех…почему-то. И в итоге может получиться вот такая штука: Вот именно для такой ситуации я набросал небольшую функцию хэлпера IndexOf, которая ищет первый элемент в списке с заданным названием (всё-таки не всегда элементы меню находящиеся на одном уровне имеют одинаковое название).