Вдогонку к предыдущему посту еще немного поговорим о 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;
Здесь в общем-то никакой магии нет. Метод по большому счету делает только три важные вещи:
- Пробегает по списку вкладок, определяя максимальную высоту вкладки (MaxHeight);
- Располагает «тело» TTabControl’а на доступном ему пространстве, сдвигая его верхнюю часть вниз на эти самые MaxHeight пикселей;
- Таким образом сверху остается полоска свободного пространства и там спокойно можно расположить кнопки вкладок.
К этому всему теперь требуется добавить установку позиции моей новой неклиентской панели. Что для этого требуется? Значение 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 терпения и удачи в доводке этого фреймворка до ума.
