Наконец-то разжился Delphi XE2 и пробую работать с FireMonkey. Довольно интересно, FireMonkey выглядит гибкой штукой. Особенно привлекает кроссплатформенность. Расскажу о том, что успел понять.
Решил начать с простенькой кастомизации компонента, чтобы получше разобраться с тем, как все устроено внутри. Под руку попался TTabControl, мне не хватает «крестика» на каждой вкладке, чтобы их можно было закрывать как в браузере. Очевидно, что наследоваться необходимо от класса TTabItem.
Небольшое лирическое отступление. Вообще, все визуальные компоненты в FireMonkey делятся на две категории: примитивные (наследники TShape) и стилизованные (наследники TStyledControl). Примитивные не делают ничего особо полезного, кроме рисования различных квадратов и окружностей на своей канве, по сути очень напоминая старый добрый TGraphicControl в VCL. А вот стилизованные уже интереснее — они имеют стиль.
Важно отметить, что стиль — это не разноцветная «шкурка», а контрол. Например, стиль TButton состоит из набора прямоугольников, текста и эффектов к ним применяемых. Фактически, говоря в терминах VCL, в FireMonkey любой стилизованный компонент очень похож на фрейм. Т.е. имеет разделенные код и визуальное представление, которое в широких рамках можно менять.
Вернемся к вкладкам TTabControl’а. Довольно интересный для меня момент, что стиль вкладки не имеет ничего общего с её содержимым и описывает всего-лишь саму кнопку. В качестве родителя для компонентов, которые должны на ней располагаться, вкладка использует отдельный контейнер типа TContent. Это позволяет отрисовывать вкладку в два этапа: сначала рисовать кнопку, а затем располагать TContent на теле TTabControl’а-родителя, если эта вкладка активна. За подробностями отсылаю к методам TTabItem.Realign и TTabControl.Realign.
Становится ясно, что добавление «крестика» нужно начать с изменения стиля вкладки. Способ рисования я подсмотрел у TCheckBox и реализовал, добавив в стиль компонент TPath (неплохое описание этого компонента есть тут) с соответствующими свойствами. А также эффект для него, чтобы при наведении курсора «крестик» подсвечивался.
Способ привязки стиля к кастомному компоненту описан в справке. Суть в том, чтобы сохранить текст стиля в ресурс. Не очень удобно, честно говоря.
Сохраняю измененный стиль в файл ClosableTabItem.style. Текст стиля у меня в итоге получился вот такой, очень похоже на DFM, я не зря сравнил с фреймами :)
object TLayout
StyleName = 'CloseableTabItemStyle'
Position.Point = '(276,419)'
Width = 145.000000000000000000
Height = 22.000000000000000000
object TRectangle
Align = alContents
Position.Point = '(0,2)'
Locked = True
Width = 148.000000000000000000
Height = 20.000000000000000000
Padding.Rect = '(0,2,-3,0)'
HitTest = False
Fill.Color = xFFEFEFEF
Stroke.Color = xFF898C95
Corners = [crTopLeft, crTopRight]
Sides = [sdTop, sdLeft, sdRight]
object TRectangle
Align = alContents
Width = 148.000000000000000000
Height = 20.000000000000000000
HitTest = False
Fill.Kind = bkGradient
Fill.Gradient.Points = <
item
Color = x24F4F4F4
end
item
Color = x24EAEAEA
Offset = 0.499000012874603300
end
item
Color = x4E868686
Offset = 0.500000000000000000
end>
Stroke.Color = xC84F4F4F
Corners = [crTopLeft, crTopRight]
Sides = [sdTop, sdLeft, sdRight]
object TFloatAnimation
Duration = 0.000000999999997475
Trigger = 'IsSelected=false'
StopValue = 1.000000000000000000
PropertyName = 'Opacity'
end
object TFloatAnimation
Duration = 0.000009999999747379
Trigger = 'IsSelected=true'
StartValue = 1.000000000000000000
StopValue = 0.001000000047497451
PropertyName = 'Opacity'
end
end
object TColorAnimation
Duration = 0.000009999999747379
Trigger = 'IsMouseOver=true;IsSelected=false'
StartValue = xFFEFEFEF
StopValue = xFFA5D9FF
PropertyName = 'Fill.Color'
end
object TColorAnimation
Duration = 0.000009999999747379
Trigger = 'IsMouseOver=false;IsSelected=false'
StartValue = xFFA5D9FF
StopValue = xFFEFEFEF
PropertyName = 'Fill.Color'
end
object TColorAnimation
Duration = 0.000000999999997475
Trigger = 'IsSelected=false'
StartValue = xFFFEFEFE
StopValue = claWhite
PropertyName = 'Fill.Color'
end
object TColorAnimation
Duration = 0.000009999999747379
Trigger = 'IsSelected=true'
StartValue = claWhite
StopValue = xFFFEFEFE
PropertyName = 'Fill.Color'
end
object TRectAnimation
Duration = 0.000009999999747379
Trigger = 'IsSelected=true'
StartValue.Rect = '(0,2,-1,0)'
StopValue.Rect = '(0,0,-1,-1)'
PropertyName = 'Padding'
end
object TRectAnimation
Duration = 0.000009999999747379
Inverse = True
Trigger = 'IsSelected=false'
StartValue.Rect = '(0,2,-1,-1)'
StopValue.Rect = '(0,0,-1,0)'
PropertyName = 'Padding'
end
object TText
StyleName = 'text'
Align = alClient
Position.Point = '(3,3)'
Locked = True
Width = 121.000000000000000000
Height = 15.000000000000000000
Padding.Rect = '(3,3,3,2)'
HitTest = False
Text = 'item'
WordWrap = False
end
object TPath
StyleName = 'close'
Align = alFitRight
Position.Point = '(132,5)'
Width = 11.000000000000000000
Height = 10.000000000000000000
Padding.Rect = '(5,5,5,5)'
Data.Path = {
1200000000000000000000000000000001000000CDCC4C3E0000000001000000
0000003F9A99993E01000000CDCC4C3F00000000010000000000803F00000000
010000000000803FCDCC4C3E010000003333333F0000003F010000000000803F
CDCC4C3F010000000000803F0000803F01000000CDCC4C3F0000803F01000000
0000003F3333333F01000000CDCC4C3E0000803F01000000000000000000803F
0100000000000000CDCC4C3F010000009A99993E0000003F0100000000000000
CDCC4C3E010000000000000000000000030000000000000000000000}
object TGlowEffect
Trigger = 'IsMouseOver=true'
Enabled = False
Softness = 0.400000005960464400
GlowColor = claDarkred
Opacity = 0.899999976158142100
end
end
end
end
Сооветственно, нужен и RC-файл:
ClosableTabItemStyle RCDATA "ClosableTabItem.style"
Теперь, продолжая следовать справке, пишем метод загрузки объекта стиля:
function TClosableTabItem.GetStyleObject: TControl;
var
S: TResourceStream;
const
Style = 'ClosableTabItemStyle';
begin
if (FStyleLookup = '') then
begin
if FindRCData(HInstance, Style) then
begin
S := TResourceStream.Create(HInstance, Style, RT_RCDATA);
try
Result := TControl(CreateObjectFromStream(nil, S));
Exit;
finally
S.Free;
end;
end;
end;
Result := inherited GetStyleObject;
end;
Вот и все. Почти. Но уже можно писать тестовое приложение. Бросаем на форму TTabControl и кнопку, которая будет добавлять вкладки:
procedure TForm1.Button1Click(Sender: TObject);
var
NewTab: TClosableTabItem;
begin
NewTab := TClosableTabItem.Create(TabControl1);
NewTab.Parent := TabControl1;
NewTab.Text := 'New Tab';
end;
Кажется, можно запускать. Крестик появился и даже подсвечивается, но ничего полезного не делает :)
Чтобы вкладка смогла закрываться, нужно добавить еще немножко кода. Мелочи вроде объявления переменных FOnCloseQuery и FOnClose опускаю.
Не придумал ничего лучше, чем присваивать обработчик OnClick в момент применения стиля. Судя по коду компонентов FireMonkey, кажется, это вполне нормальная практика.
procedure TClosableTabItem.ApplyStyle;
var
CloseButton: TfmxObject;
begin
inherited;
CloseButton := FindStyleResource('close');
if (CloseButton <> nil) and (CloseButton is TControl) then
TControl(CloseButton).OnClick := CloseButtonClick;
end;
procedure TClosableTabItem.CloseButtonClick(Sender: TObject);
var
CanClose: Boolean;
TabControl: TTabControl;
begin
CanClose := True;
if Assigned(FOnCloseQuery) then
FOnCloseQuery(Self, CanClose);
if CanClose then
begin
if Assigned(FOnClose) then
FOnClose(Self);
TabControl := Self.Parent as TTabControl;
Self.Free;
TabControl.Realign;
end;
end;
Простенько, но на данном этапе мне большего и не нужно. Полный код можно скачать здесь.
А теперь плохая новость. В рантайме все работает, но я не нашел никакого способа добавить свой новый тип вкладки в Items Designer. И похоже, что та же самая проблема есть у всех списковых контролов: TListBox, TGrid и т.п. Сначала мне подход к их реализации очень понравился, а вот теперь даже как-то сомневаюсь. Поиск в интернете показал, что я с этой проблемой не одинок.
Справка молчит, в коде я тоже не нашел ничего. Неужели никак? Это было бы крайне неприятно.
update: QC #107177
Продолжаю работу с TTabControl. На этот раз я хочу получить возможность размещать компоненты в неклиентской области. Признаюсь, хочу повторить функционал браузеров — разместить кнопку для открытия новых вкладок справа от них.