Вдогонку к предыдущему посту еще немного поговорим о FireMonkey. Очень неприятная для меня вещь — ощущение, что при разработке стандартных компонентов никто и не задумывался, что от них кто-то будет наследоваться, пытаться расширять и изменять их поведение. Если сравнивать с VCL, то доступных компонентов FireMonkey сейчас очень и очень мало. И мне кажется, что судьба фреймворка сегодня во многом зависит именно от удобства разработки новых компонентов.

Разберу конкретный пример.

Продолжаю работу с TTabControl. На этот раз я хочу получить возможность размещать компоненты в неклиентской области. Признаюсь, хочу повторить функционал браузеров — разместить кнопку для открытия новых вкладок справа от них.

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

Реализация очевидна. Нужен контрол с простейшим стилем (скажем, только TLayout), его расположим на TTabControl’е и будем позиционировать по аналогии с вкладками. Напомню, что вкладка здесь — это только сама кнопка, мне же хочется всего-лишь оказаться правее кнопок.

Смотрим на метод TTabControl.Realign. Метод длинный, но из песни слов не выкинешь. Можно перемотать, его суть в двух словах я перескажу чуть позже.

procedure TTabControl.Realign;
var
  Idx, i: Integer;
  CurX, CurY: Single;
  AutoWidth, MaxHeight: Single;
  B: TFmxObject;
begin
  if FDisableAlign then
    Exit;
  FDisableAlign := True;
  try
    { move all non TabItem to end of list }
    if FChildren <> nil then
      for i := 0 to FChildren.Count - 1 do
        if not(TFmxObject(FChildren[i]) is TTabItem) then
          TFmxObject(FChildren[i]).Index := FChildren.Count - 1;
    { calc max height }
    MaxHeight := 0;
    Idx := 0;
    if FChildren <> nil then
      for i := 0 to FChildren.Count - 1 do
        if TFmxObject(FChildren[i]) is TTabItem then
          with TTabItem(FChildren[i]) do
          begin
            if not Visible then
              Continue;
            FIndex := Idx;
            if Height + Padding.top + Padding.bottom > MaxHeight then
              MaxHeight := Height + Padding.top + Padding.bottom;
            Idx := Idx + 1;
          end;
    if Idx = 0 then
      MaxHeight := 0
    else if FTabHeight > 0 then
      MaxHeight := FTabHeight;
    { background }
    if FResourceLink <> nil then
    begin
      B := FResourceLink;
      if (B <> nil) and (B is TControl) then
        begin
          TControl(B).Align := TAlignLayout.alNone;
          TControl(B).SetBounds(TControl(B).Padding.left, MaxHeight + TControl(B).Padding.top,
            Width - TControl(B).Padding.left - TControl(B).Padding.top,
            Height - MaxHeight - TControl(B).Padding.top - TControl(B).Padding.bottom);
          TControl(B).BringToFront;
        end;
    end;
    { align }
    CurX := 0;
    CurY := 0;
    AutoWidth:= Width;
    if FBackground <> nil then
      AutoWidth := Width - FBackground.Margins.left - FBackground.Margins.right;
    if FFullSize and (Idx > 0) then
      AutoWidth := AutoWidth / Idx
    else
      AutoWidth := AutoWidth;

    if FChildren <> nil then
      for i := 0 to FChildren.Count - 1 do
        if TFmxObject(FChildren[i]) is TTabItem then
          with TTabItem(FChildren[i]) do
          begin
            if not Visible then
              Continue;
            Align := TAlignLayout.alNone;

            FContent.Align := TAlignLayout.alNone;
            FContent.Visible := Index = TabIndex;
            FContent.DesignVisible := (Index = TabIndex);
            FContent.ClipChildren := True;
            if FContent.Visible then
              FContent.BringToFront;

            if FFullSize then
              SetBounds(CurX + Padding.left, CurY + Padding.top, AutoWidth,
                MaxHeight - Padding.top - Padding.bottom)
            else
              SetBounds(CurX + Padding.left, CurY + Padding.top, Width,
                MaxHeight - Padding.top - Padding.bottom);
            CurX := CurX + Padding.left + Width + Padding.right;
          end;
  finally
    FDisableAlign := False;
  end;
  inherited;
end;

Здесь в общем-то никакой магии нет. Метод по большому счету делает только три важные вещи:

  1. Пробегает по списку вкладок, определяя максимальную высоту вкладки (MaxHeight);
  2. Располагает «тело» TTabControl’а на доступном ему пространстве, сдвигая его верхнюю часть вниз на эти самые MaxHeight пикселей;
  3. Таким образом сверху остается полоска свободного пространства и там спокойно можно расположить кнопки вкладок.

К этому всему теперь требуется добавить установку позиции моей новой неклиентской панели. Что для этого требуется? Значение MaxHeight, чтобы знать высоту данного пространства, и координаты крайней правой кнопки. К тому же нужно внести небольшие изменения в логику размещения кнопок, запретив им занимать всю ширину TTabControl’а — у вкладок не должно быть возможности сделать ширину неклиентской панели меньше какого-то установленного значения.

И, честно говоря, я не вижу способа сделать это красиво. Перегрузка Realign не поможет. В итоге придется продублировать довольно приличные по объему куски кода. Например, MaxHeight будет вычисляться дважды. Это конечно мелочь, но быстродействия не прибавит, а вот багов прибавить может.

Не буду предлагать ничего глобального, покажу только к чему мог бы привести маленький и очень простой рефакторинг. Давайте признаемся сами себе, что сейчас Realign если и не нарушает «single responsibility principle», то явно балансирует на грани.

Нужно разбить метод Realign на более мелкие части. Тем более, разработчик компонента уже сделал половину работы, разделив его на 4 части комментариями.

{ move all non TabItem to end of list }
{ calc max height }
{ background }
{ align }

Таким образом, получилось бы что-то вроде:

procedure TTabControl.Realign;
var
  MaxHeight: Single;
begin
  SortItems(...);
  MaxHeight := CalcMaxHeight(...);
  AlignBackground(MaxHeight, ...);
  AlignTabs(MaxHeight, ...);

  inherited;
end;

Итого 4 новых метода со старым кодом. Каждый из которых должен быть виртуальным. Тогда вся моя работа свелась бы к перегрузке метода AlignTabs. В нем бы и значение MaxHeight было доступно, и логику размещения вкладок я бы смог изменить, не затрагивая всего остального, ну и конечно же добавить новую панель.

К сожалению, описанная проблема — это не частный случай. Покажу еще один пример.

TMemo в FireMonkey реализован довольно интересно. Текст рисуется простым FillText’ом на канве, а для позиционирования каретки используется соответственно вычисление высоты строк и ширины фрагмента текущей строки. Возможности кастомизации на первый взгляд безграничны.

Мне показалось интересным попробовать реализовать простенькую подсветку синтаксиса. Рисование устроено просто: обработчику OnPaint канвы присваивается метод DoContentPaintWithCache, он когда нужно вызывает DoContentPaint для рисования, а когда можно просто рисует старую картинку из кэша.

Проблемы начинаются с того, что обе функции не виртуальны. То есть я не могу просто перегрузить DoContentPaint, я должен сначала скопировать в своем наследнике код DoContentPaintWithCache, заменив вызов DoContentPaint на свой новый метод рисования. А затем эту копию установить обработчиком OnPaint. Только что произошло дублирование ~50 строк кода. Одно лишь ключевое слово «virtual» в объявлении метода TMemo.DoContentPaint избавило бы от всего этого.

Но это еще не вся проблема. DoContentPaint — большой метод (~120 строк), а мне всего-лишь нужно заменить в нем простой FillText на что-то чуть более сложное. То есть снова необходимо скопировать весь код, заменив в нем пару вызовов.

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

Disclaimer: Не хочу быть неправильно понят, на самом деле затея с FireMonkey мне нравится. Но вот головой о стены я побился уже изрядно. Желаю Embarcadero терпения и удачи в доводке этого фреймворка до ума.

Связанные записи: