Все мы знаем и любим Virtual TreeView (VT). Бесплатный, быстрый, разнообразный. Mike Lischke подарил миру воистину бесценный инструмент. Настолько бесценный, что Embarcadero весьма активно использует его в своей среде, правда, без включения в стандартный набор компонент. Что само по себе не поддается осмыслению.
Помимо древовидного представления, VT запросто трансформируется в табличный вид. На стыке древа и таблицы у многих возникает желание иметь возможность отображения агрегированных данных. Которое можно транслировать как «хочу футеры, как в Developer Express или EhLib».
В самом VT нет ни намека на возможность реализации футеров. Однако, в очередной раз обратившись к знаменитому демонстрационному примеру Virtual-TreeView\Demos\Advanced, можно убедиться, что могучие возможности VT – это комбинация правильно выставленных свойств и грамотной обработки нужных событий.
Безусловно, попытки сделать футеры в VT были. Были и канули в лету. По причине ошибочности стремления любую проблему облечь в компонент. Прелесть VT в том, что можно решить любую возникающую проблему непосредственно «тут», вот прямо тут в коде проекта сделать маленькое вау-чудо. Просто надо выставить свойство и обработать событие.
Невозможно сделать компонент, решающий все проблемы. Любой компонент ограничивает свободу творчества рамками «заботы» создателя. VT выставил рамки настолько широкие – есть небо, есть земля, дыши и твори – что свобода кажется бесконечной.
Поэтому футеры VT, по крайней мере в контексте этой статьи — это комплекс свойств и обработчиков событий. Такой подход должен закрывать вопросы, типа – а можно будет по центру выровнять текст в футере? Можно. И так тоже можно. Да и так тоже. Как угодно можно.
Постановка задачи
Вкратце, суть задачи представлена на рисунке 1. Нужно из древа на заднем плане получить супер-таблицу с футерами, как на переднем.
На входе
Допустим, у нас есть некие данные. Сгруппированные каким-либо, нужным нам, образом. Есть посчитанные агрегированные значения. Для задачи реализации футера это не столь важно, в каком виде представлены эти данные. Задача – отобразить.
На выходе
На выходе хотим видеть таблицу, в которой данные представлены группами, желательно, с цветовым разделением, в стиле, характерном для подобного рода отображения информации. Внизу каждой группы есть полоса с агрегированными значениями. Футер. Если группа свернута, полоса футера этой группы не видна. Внизу таблицы присутствует «глобальный» футер, видимый все время.
Несколько слов в защиту VT
Казалось бы, такая нужная и полезная вещь, как футер, в таком продвинутом и популярном инструменте, как VT, обязана быть. Не обязана.
VT не манипулирует данными, не сортирует, не создает, не уничтожает. Он предоставляет возможности для этого. Это основная концепция — ничего не знать о данных. Как перевозчик, ничего не хочет знать о грузе. Если бы VT был нагружен еще и данными, он потерял бы скорость и сильно ограничил свободу действий.
Футер, как представитель агрегированного сословия, это в первую очередь данные. За данные целиком отвечает программист. В VT достаточно средств и возможностей все организовать самостоятельно.
Формирование групп и данных
Для статьи был написан класс хранилища данных, позволяющий произвольно группировать и агрегировать данные. Его внутренняя реализация в рамках статьи не интересна. На его месте могут быть любые данные, в том числе и несколько наследников TDataSet’ов, один из которых отвечает за данные, другой за агрегированные данные и т.д.
Главное, что для подобной задачи сразу же надо забыть про такую «фишку» VT, как динамическая инициализация данных. Так или иначе, нам нужны сразу все данные, иначе не получится правильно ни сгруппировать, ни агрегировать.
//*********************************************************************
// обновить данные в дереве
//*********************************************************************
function UpdateDataTree(const ATree: TBaseVirtualTree;
const AData: TxIPVTVData;
const AWithMainFooter: Boolean = True): Boolean;
function AddNode(const ANode: PVirtualNode;
const AItem: TxIPVTVBaseNode;
const ARecurse: Boolean = True): PVirtualNode;
var
i : Integer;
begin
Result := nil;
if (not Assigned(AItem)) then
Exit;
if AItem <> AData then
begin
Result := ATree.AddChild(ANode, AItem);
Result.States := Result.States + [vsExpanded];
end;
if ARecurse then
for i := 0 to AItem.ChildCount-1 do
AddNode(Result, AItem.Childs[i]);
if (AItem is TxIPVTVNode) and (TxIPVTVNode(AItem).NodeType=xntGroup)
then
AddNode(Result, TxIPVTVNode(AItem).Footer, False);
end;
begin
Result := Assigned(ATree) and Assigned(AData);
if not Result then
Exit;
ATree.BeginUpdate;
try
ATree.Clear;
AddNode(nil, AData);
if AWithMainFooter then
AddNode(nil, AData.Footer, False);
finally
ATree.InitRecursive(nil);
ATree.EndUpdate;
end;
end;
Как видим, все достаточно тривиально. Копируем иерархическую структуру из хранилища в древо с добавлением узла-футера в конец каждой группы. Также, опционально, добавляем главный футер в конец всего набора.
TxIPVTVData – класс хранилища, в котором произведена нужная группировка и расчеты.
TxIPVTVNode – класс узла хранилища, который может быть трех видов – данные, группа или футер.
Таким образом, получили древо, где с каждым узлом связан экземпляр TxIPVTVNode. Обрабатывать OnFreeNode смысла нет, т.к. удаление записи все равно будет (если вообще будет) производиться через интерфейс, освобождение или другие манипуляции с экземпляром лучше делать там.
Для получения экземпляра TxIPVTVNode из узла VT делаем так.
//********************************************************************
// Получить элемент указанного класса из указанного узла
//********************************************************************
function GetIPVTVNode(const AVT: TBaseVirtualTree;
ANode: PVirtualNode = nil;
AClass: TxIPVTVNodeClass = nil): TxIPVTVNode;
var
NodeData: ^TObject;
begin
NodeData := nil;
Result := nil;
if (not Assigned(AClass)) then
AClass := TxIPVTVNode;
if (not Assigned(ANode) and Assigned(AVT)) then
ANode := AVT.FocusedNode;
if Assigned(ANode) and Assigned(AVT) then
NodeData := AVT.GetNodeData(ANode);
if (Assigned(NodeData) and (NodeData^ is AClass)) then
Result := NodeData^ as AClass;
end;
В результате всего этого получаем вид древа, который представлен на рис.2.
Начнем превращать дерево в таблицу.
Группы
Для начала уберем toShowHorzGridLines и toShowTreeLines из TreeOptions.PaintOptions. Добавим следующие опции — toHideFocusRect и toHideSelection в TreeOptions.PaintOptions.
Далее, нам понадобится разный цвет для групп разного уровня.
//******************************************************************** // Получить цвет уровня //******************************************************************** function TFmMain.GetLevelColor(Sender: TBaseVirtualTree; ALevel: Integer): TColor; begin Result := Lighter(clLevelColor, ALevel * FLevelColorIndent); end;
Далее, обработаем событие OnBeforeCellPaint. В нем нам нужно указать цвет фона для будущей отрисовки содержимого узла.
//********************************************************************
// "Красим" подложку
//********************************************************************
procedure TFmMain.vtvBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect;
var ContentRect: TRect);
var
n: TxIPVTVNode;
rct: TRect;
OffX: Integer;
Level: Integer;
begin
n := GetNodeItem(Node);
if (not Assigned(n)) then
Exit;
if Column = Sender.Header.MainColumn then
with TargetCanvas do
begin
rct := CellRect;
OffX := GetTreeIndent(Sender);
Level := Sender.GetNodeLevel(Node);
if (n.NodeType = xntData) then
rct.Right := rct.Left + Level * OffX;
Brush.Color := GetLevelColor(Sender, Level);
FillRect(rct);
end;
end;
Хотелось бы видеть группу полностью, на всю ширину таблицы. Добавим опцию toAutoSpanColumns в TreeOptions.AutoOptions.
Уже похоже на дело. Сделаем группы жирным и выведем данные футера рядом с названием группы.
Для вывода дополнительной информации, статического текста, добавим опцию toShowStaticText в TreeOptions.StringOptions. И обработаем события OnGetCellText и OnPaintText. Первое отвечает за выводимый в ячейку текст, второе за графические параметры отображения текста.
//********************************************************************
// Получить текст для отображения в гриде
//********************************************************************
procedure TFmMain.vtvGetCellText(Sender: TCustomVirtualStringTree;
var E: TVSTGetCellTextEventArgs);
var
n: TxIPVTVNode;
CellText: String;
begin
n := GetNodeItem(E.Node);
CellText := '';
if not Assigned(n) then
begin
// Если нет данных, но банк не пуст - это что-то из ряда вон
if FData.Count > 0 then
CellText := '... INTeRestInG :-/ ...';
end
else
// Для групп заполнем только "древовидный" столбец
if n.NodeType = xntGroup then
begin
if E.Column in [Sender.Header.MainColumn] then
CellText := n.FullText;
// Опционально, если требуется показать футер у группы
if chbShowFooterData.Checked then
E.StaticText := n.Footer.FullText;
end else
if E.Column > 0 then
begin
CellText := n[E.Column];
// Если будет "пусто" ячейки могут слиться
if CellText.IsEmpty then
CellText := ' ';
end;
E.CellText := CellText;
end;
//***************************************************************
// Графические параметры вывода строк в ячейке
//***************************************************************
procedure TFmMain.vtvPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
var
n: TxIPVTVNode;
begin
n := GetNodeItem(Node);
if Assigned(n) and (n.NodeType = xntGroup) then
begin
// "жирность" начертания групп
if TextType = ttNormal then
TargetCanvas.Font.Style := [fsBold];
// "курсивность" начертания футеров у групп
if TextType = ttStatic then
begin
TargetCanvas.Font.Name := 'Arial';
TargetCanvas.Font.Style := [fsItalic];
if (vsSelected in Node.States) and (Sender.Focused) then
TargetCanvas.Font.Color := clHighlightText
else
TargetCanvas.Font.Color := FFooterLineColor;
end;
end;
end;
Понятно, что на вкус и цвет. Формат отображения можно легко подстроить под свои представления о прекрасном.
Видим, что в принципе уже хорошо, но хочется, чтобы выделение было на всю строку группы. Для этого включим опцию toGridExtensions в TreeOptions.MiscOptions. Также, можем заметить, что фокус не переходит на другие столбцы, перемещается только в пределах главного «древовидного» столбца. Лечим это включением опции toExtendedFocus в TreeOptions.SelectionOptions.
Теперь надо сделать уровни группировки. Вот те самые разноцветные полосы слева. На рисунке 7 видим, как это должно выглядеть.
Разноцветные уровни групп
Создать иллюзию непрерывности можно рисуя в каждой ячейке «древовидного» столбца вертикальные полосы цветом уровня группы. Для определения цвета у нас уже есть функция. Предлагается следующая функция для отрисовки этих полос.
type
TxIPGetColorEvent = function(Sender: TBaseVirtualTree;
ALevel: Integer): TColor of object;
//********************************************************************
// Нарисовать уровни (области слева) до указанного уровня
//********************************************************************
function VTDrawLevels(const ACanvas: TCanvas; const ARect: TRect;
const AVT: TBaseVirtualTree; const ALevel: Integer;
AGetLevelColor: TxIPGetColorEvent = nil): Boolean;
function DoEvent(const L: Integer): TColor;
begin
if Assigned(AGetLevelColor) then
Result := AGetLevelColor(AVT,L)
else
Result := clBtnFace;
end;
var
OffX: Integer;
rct: TRect;
i: Integer;
begin
Result := CheckParamsValid(ACanvas, ARect, AVT) and (ALevel > -1);
if not Result then Exit;
rct := ARect;
OffX := GetTreeIndent(AVT);
rct.Right := rct.Left + OffX;
with ACanvas do
begin
Brush.Style := bsSolid;
for i := 0 to ALevel do
begin
Brush.Color := DoEvent(i);
FillRect(rct);
if CheckPaintOptions(AVT, toShowVertGridLines) then
VertLine(ACanvas, rct.Right-1, rct.Top, rct.Bottom);
OffsetRect(rct, OffX, 0);
end;
end;
end;
Обрабатываем событие OnAfterCellPaint. В нем пишем следующее.
//********************************************************************
// Поэтапная отрисовка древа
//********************************************************************
procedure TFmMain.vstAfterCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellRect: TRect);
var
rct: TRect;
OffX: Integer;
Level: Integer;
Text: String;
Curr: TxIPVTVNode;
Next: TxIPVTVNode;
Step: Integer;
begin
// Если есть вертикальные полосы, добавляем справа 1
if CheckPaintOptions(Sender, toShowVertGridLines) then
Inc(CellRect.Right);
// Предварительная инициализация
with TargetCanvas do
begin
Brush.Color := clBtnFace;
Font.Color := clWindowText;
Pen.Color := FFooterLineColor;
end;
Next := nil;
Curr := GetIPVTVNode(Sender, Node);
if Assigned(Node) then
Next := GetIPVTVNode(Sender, Sender.GetNextVisible(Node));
// Сохраняем прямоугольник ячейки
rct := CellRect;
// Получаем смещение слева из свойств древа
OffX := GetTreeIndent(Sender);
// Находим уровень узла
Level := Sender.GetNodeLevel(Node);
// Рисуем полосы группировки только для "древовидного" главного столбца
if (Column = Sender.Header.MainColumn) then
VTDrawLevels(TargetCanvas, CellRect, Sender, Level-1, GetLevelColor);
end;
Сейчас будем постепенно добавлять функционал в этот обработчик.
Рисуем футер
С футером все просто на самом деле. Градировать пока не требуется, это уж на усмотрение программиста или заказчика. Просто закрасим поле футера нужным цветом. Вставим этот фрагмент перед рисованием полос:
// Рисуем поле футера для всех столбцов кроме нулевого
if (Curr.NodeType = xntFooter) and (Column > 0) then
begin
Text := Curr[Column];
TargetCanvas.FillRect(CellRect);
// Если это "древовидный" столбец, считаем левую границу
if Column = Sender.Header.MainColumn then
rct.Left := rct.Left + OffX*Level;
InflateRect(rct, -4, 0);
DrawTextEx(TargetCanvas, rct, Text, slCenter,
FData.Columns[Column].FooterAlignment);
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
if FData.Columns[Column].DrawFooterVertLine then
VertLine(TargetCanvas, CellRect.Right-1,
CellRect.Top, CellRect.Bottom);
end;
Последующее рисование полос перекрывает и ненужную часть выделения текущего узла и часть футера, «вылезающую» слева за ограничение группы. Также рисуем и текст, т.к. настройка футера может отличаться от настроек столбца в VT. Это вот то самое – «а можно будет по центру?»
Итак, появились ограничивающие линии. Причина, из-за чего мы исключили из опций рисование горизонтальных линий.
Разделительные линии
Начнем с простого, добавим опцию toShowVertGridLines в TreeOptions.PaintOptions. Т.к. наличие этой опции уже предусмотрели в VTDrawLevels эффект видим сразу.
if CheckPaintOptions(AVT, toShowVertGridLines) then
VertLine(ACanvas, rct.Right-1, rct.Top, rct.Bottom);
Однако, возникает вопрос — как посчитать левую координату прочих линий. Как видно на рисунке 9, в зависимости от ситуации, координата должна быть разная. В одних случаях отстоять на определенный интервал от предыдущей линии, в других пересекать ее.
Вначале рисуем лини для ячеек. Там все просто, единственное что, для последней ячейки перед футером меняем цвет пера.
Этот фрагмент кода разместим перед рисованием футера. Нулевой столбец не трогаем, для него отдельная рисовка.
if Column > 0 then
with TargetCanvas do begin
Brush.Style := bsSolid;
if (Curr.NodeType = xntData) then
begin
if Assigned(Next) and (Next.NodeType in [xntGroup, xntFooter])
then // подо мной серьезные ноды, подчеркнем этот факт
Pen.Color := FFooterLineColor
else // подо мной такие же ноды, равенство в цвете
Pen.Color := FDataLineColor;
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
end;
end;
Для разграничения групп и футеров используем такой код. Вставляем в конец обработчика, после всех отрисовок. Для определения левой координаты линии нас интересует только главный «древовидный» столбец. В конце рисуем вертикальную закрывающую линию.
if (Column = Sender.Header.MainColumn) then
begin
if Curr.NodeType in [xntGroup, xntFooter] then
begin
// Если раскрыт и имеет чилдов
if (vsHasChildren in Node.States) and (vsExpanded in Node.States)
then
Level := Level + 1
else //Если последний в обойме
if NodeIsLast(Sender, Node) then
Level := Level - 1;
// Нижняя линия
HorzLine(TargetCanvas, CellRect.Left + Level*OffX - 1,
CellRect.Right, CellRect.Bottom - 1);
// Правая закрывающая линия
if Curr.NodeType = xntGroup then
VertLine(TargetCanvas, CellRect.Right-1, CellRect.Top,
CellRect.Bottom);
end;
end;
// Правая закрывающая линия для последнего видимого столбца
if ((Curr.NodeType in [xntGroup, xntFooter]) and
(Sender.Header.Columns.GetLastVisibleColumn = Column))
then
VertLine(TargetCanvas, CellRect.Right-1, CellRect.Top,
CellRect.Bottom);
Займемся нулевым столбцом.
Нулевой столбец
Белое пятно слева – это во первых непорядок, во-вторых здесь задумывается маркер текущей строки а-ля TDBGrid и иже с ним. Подготовим где-нибудь ранее битмап маркера треугольника.
// Создаем треугльник слева - маркер текущей строки
FMark := TBitmap.Create;
FMark.Width := 9;
FMark.Height := 9;
with FMark.Canvas do
begin
Brush.Color := clWhite;
FillRect(ClipRect);
Brush.Color := clBlack;
Polygon([Point(2, 0), Point(6, 4), Point(2, 8)]);
end;
FMark.Transparent := True;
Нарисуем нулевой столбец. Разместим этот фрагмент вначале всех рисовок в обработчике.
if Column = 0 then
begin
with TargetCanvas do
begin
// рамку рисуем всегда, в конкретных случаях всегда можно изменить
Rectangle(CellRect.Left-1, CellRect.Top-1, CellRect.Right,
CellRect.Bottom);
// это сфокусированный элемент - нарисовать маркер-треугольник
if Node = Sender.FocusedNode then
Draw(CellRect.Left + 4, CellRect.Top +
round((CellRect.Height - FMark.Height)/2), FMark);
// Самый нижний видимый элемент - подрисовать линию снизу
if (not Assigned(Sender.GetNextVisible(Node))) then
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
end;
end;
Несколько режет глаз стиль заголовков. Стал отличаться от общего вида таблицы. Но вид столбцов – это уже свой собственный субъективный взгляд. К теме статьи отношения не имеет.
Остался небольшой нюанс. Картинка свернуть/развернуть находятся прямо у линии. Такое ощущение, что глиф выровнен по правому краю отведенного ему прямоугольника. Привычней как-то, чтобы он был посередине.
Лечим установкой свойства Margin в 0.
На рис. 12 видим в том числе и главный футер. Который, к сожалению, исчезает из поля видимости при скролировании.
Глобальный футер
Можно рисовать главный футер в конце поверх всех отрисовок . Но практика показывает, что во-первых, иногда видны «промаргивания» фона под ним, во-вторых, хочется вернуться к теме – все делаю тут и сейчас, вне рамок заботы обо мне автора возможного компонента и поэтому волен делать все что захочу.
Поэтому глобальным футером назначается TPanel.
Сделаем главный футер больше остальных. Потому что он главный. Для этого включим опцию toVariableNodeHeight в TreeOptions.MiscOptions. И обработаем событие OnMeasureItem.
//********************************************************************
// Высота главного футера
//********************************************************************
procedure TFmMain.vtvMeasureItem(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
var
n: TxIPVTVNode;
begin
n := GetIPVTVNode(Sender, Node);
if Assigned(n) and (n=FData.Footer) then
begin
if pnlFooter.Visible then
NodeHeight := 0
else
NodeHeight := FBottomSpace;
end;
end;
FBottomSpace посчитаем где-то раньше. У меня это так:
// Варианты высоты главного футера
FBottomSpace := round(vtv.Header.Height*1.3);
Далее обработаем событие OnAfterPaint, где будем позиционировать панель в необходимое место.
//********************************************************************
// Определить текущее положение глобального футера и
// установить позицию панели
//********************************************************************
procedure TFmMain.vtvAfterPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas);
var
rct: TRect;
begin
pnlFooter.Height := FBottomSpace;
if not pnlFooter.Visible then
Exit;
pnlFooter.Parent := Sender.Parent;
img.Width := Sender.Header.Columns[0].Width;
rct := Sender.ClientRect;
rct.Top := rct.Bottom - FBottomSpace;
rct.TopLeft := pnlFooter.Parent.ScreenToClient(
Sender.ClientToScreen(rct.TopLeft));
rct.BottomRight := pnlFooter.Parent.ScreenToClient(
Sender.ClientToScreen(rct.BottomRight));
pnlFooter.BoundsRect := rct;
pbPaint(pb);
end;
Как замечаем, производится анализ видимости панели. Может кому-то не хочется, чтобы глобальный футер был панелью. В демо примере видимость панели регулируется соответствующей галочкой. На панели разместим TLabel и TPaintBox, внутри обработчика OnPaint которого есть вызов функции рисовки футера.
//********************************************************************
// Нарисовать футер
//********************************************************************
function VTDrawFooter(const ACanvas: TCanvas; const ARect: TRect;
const AVT: TBaseVirtualTree; const ANode: TxIPVTVNode;
const AVTNode: PVirtualNode = nil;
ADrawEvent: TxIPDrawTextEvent = nil): Boolean;
const
LeftIndent = 6;
var
VTNode: PVirtualNode;
VTColumn: TVirtualTreeColumn;
BorderX: Integer;
Column: TxIPVTVColumn;
Data: TxIPVTVData;
Text: String;
rct: TRect;
i: Integer;
begin
Result := (Assigned(ACanvas) and Assigned(ANode) and
(ANode.NodeType = xntFooter));
if (not Result) then
Exit;
if Assigned(AVTNode) then
VTNode := AVTNode
else
VTNode := AVT.GetFirst;
Data := ANode.Owner;
with ACanvas do
begin
Brush.Style := bsClear;
for i := AVT.Header.Columns.Count-1 downto 0 do
begin
VTColumn := AVT.Header.Columns[i];
if not (coVisible in VTColumn.Options) then continue;
Column := nil;
if (Assigned(Data) and (i < Data.ColumnsCount)) then
Column := Data.Columns[i];
if Assigned(VTNode) then
rct := AVT.GetDisplayRect(VTNode, i, False)
else
rct := AVT.Header.Columns[i].GetRect;
OffsetRect(rct, ARect.Left, 0);
rct.Top := ARect.Top;
rct.Bottom := ARect.Bottom;
Text := ANode[i];
if Assigned(ADrawEvent) then
if not ADrawEvent(ACanvas, rct, Text) then
Continue;
BorderX := rct.Right;
InflateRect(rct, -LeftIndent, 0);
if Assigned(Column) then
begin
DrawTextEx(ACanvas, rct, Text, slCenter, Column.FooterAlignment);
if Column.DrawFooterVertLine then
VertLine(ACanvas, BorderX, ARect.Top, ARect.Bottom);
end
else
DrawTextEx(ACanvas, rct, Text, slCenter, VTColumn.Alignment);
end;
end;
end;
Да, пришлось писать отдельную функцию для рисования футера. Но это в очередной раз показывает, что при таком подходе можно рисовать все, что душе угодно. Можно разместить логотип компании и накидать меток. И вместо рисовок присваивать значения меткам. Одним словом, масса вариантов.
Конкретно в нашем случае сделал кнопку вызова меню. И вместе с меню это выглядит так.
Проблема с фокусом
С видимым главным футером возникает одна проблема. Сфокусированный узел может оказаться под панелью.
Чтобы ликвидировать это досадное обстоятельство, обработаем свойства OnFocusChanged (фокус сменился) и OnFocusChanging (собираюсь сменить фокус – можно?)
//***********************************************************************
// Фокус изменился – определить, надо ли и если надо - скролировать
//***********************************************************************
procedure TFmMain.vtvFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
begin
if pnlFooter.Visible then
SetBottomSpaceFocus(Sender, Node, pnlFooter.Height, Column);
end;
//***********************************************************************
// Произошел переход на главный футер, скакнуть на предыдущий
//***********************************************************************
procedure TFmMain.vtvFocusChanging(Sender: TBaseVirtualTree;
OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex;
var Allowed: Boolean);
var
n: TxIPVTVNode;
begin
n := GetIPVTVNode(Sender, NewNode);
Allowed := (not pnlFooter.Visible) or (n <> FData.Footer) or
(OldNode = NewNode);
if Allowed then exit;
NewNode := Sender.GetPreviousVisible(NewNode);
Sender.FocusedNode := NewNode;
Sender.Selected[NewNode] := True;
Sender.Invalidate;
end;
Этих мер не достаточно. Можно было бы успокоится на том, что при переходе фокуса на последний главный футер произойдет переход на предыдущий видимый. Главный футер останется под панелью и все должно быть хорошо. Но есть небольшой глюк.
Допустим, мы скачем в конец таблицы через Ctrl+End. Если бы у нас был главный футер той же высоты, что и остальные, все было бы идеально. Но у нас он другой. Поэтому, собственно, и другой. В итоге увидим, что-то подобное рисунку 14 – неполное отображение узла. Повторное нажатие Ctrl+End приведет все в норму. Но, как ни крути, это досадный глюк.
В связи с чем комплекс мер. Посмотрим на обработчик OnMeasureItem. Там есть такая запись:
if pnlFooter.Visible then
NodeHeight := 0
else
NodeHeight := FBottomSpace;
То есть, если главный футер-панель видим, высота узла главного футера становится равной нулю. Конечно, при обработке OnFocusChanging в этом случае, фокус, переходя на предпоследний узел, все равно спрячет этот узел под панель. Вот чтобы этого не было, используем свойство BottomSpace. Это свойство задает видимое пространство под последним узлом.
Как уже говорилось, за показ главного футера панели отвечает галочка в интерфейсе. И в ее обработчике есть такой фрагмент:
if Sender = chbMainFooter then
begin
// Регулируем BottomSpace
if pnlFooter.Visible then
vtv.BottomSpace := FBottomSpace
else
vtv.BottomSpace := 0;
// Приводим вертикальный скрол в правильное состояние
vtv.InitRecursive(nil);
// Позиционируем главный футер в нужно место
vtvAfterPaint(vtv, vtv.Canvas);
end;
Таким образом, помимо обработки «фокусных» событий, необходимо сделать нулевым главный футер в таблице и выставить BottomSpace равным высоте панели.
Для смещения фокуса в нужную позицию делаем скрол VT следующей функцией.
type
TMyBaseVirtualTree = class(TBaseVirtualTree);
//********************************************************************
// Установить фокус с учетом BottomSpace
//********************************************************************
function SetBottomSpaceFocus(const ATree: TBaseVirtualTree;
const ANode: PVirtualNode; const AColumn: TColumnIndex=0): Boolean;
begin
Result := SetBottomSpaceFocus(ATree, ANode, GetBottomSpace(ATree),
AColumn);
end;
function SetBottomSpaceFocus(const ATree: TBaseVirtualTree;
const ANode: PVirtualNode; const ASpace: Integer;
const AColumn: TColumnIndex): Boolean; overload;
var
bs: Integer;
rct: Trect;
begin
bs := ASpace;
Result := Assigned(ANode) and (bs > 0);
if Result then
begin
rct := ATree.GetDisplayRect(ANode, AColumn, False);
Result := ATree.ClientRect.Bottom - rct.Bottom < bs;
if Result then
TMyBaseVirtualTree(ATree).DoSetOffsetXY(
Point(ATree.OffsetX,
(ATree.ClientRect.Bottom - rct.Bottom - bs) + ATree.OffsetY),
[suoRepaintHeader, suoRepaintScrollBars, suoScrollClientArea,
suoUpdateNCArea]);
end;
end;
Зачем обнулять высоту узла главного футера, если его можно вообще не добавлять? У нас же есть функция UpdateDataTree, в которой указывается – добавлять или нет главный футер?
UpdateDataTree(const ATree: TBaseVirtualTree;
const AData: TxIPVTVData; const AWithMainFooter: Boolean = True)
Дело в том, что если вдруг (т.е. скорее всего) нам лень делать экспорт своими руками и хотим все сделать средствами VT, узел главного футера нам все таки нужен.
procedure TFmMain.btnHTMLClick(Sender: TObject);
var
sl: TStringList;
fn: String;
begin
sl := TStringList.Create;
try
if Sender = btnHTML then
begin
sl.Text := vtv.ContentToHTML(tstAll);
fn := 'html.html';
end;
if Sender = btnRTF then
begin
sl.Text := vtv.ContentToRTF(tstAll);
fn := 'rtf.rtf';
end;
sl.SaveToFile(fn);
finally
FreeAndNil(sl);
end;
ShellExecute(Handle, 'open', PChar(fn), nil, nil, SW_RESTORE);
end;
Даже при нулевой высоте, главный футер будет присутствовать в результате экспорта.
Так как опцию — показывать или нет главный футер — вряд ли понадобится переключать в реальности, особо обрабатывать ситуацию не будем. Как настроили один раз, так и отработает. Манипуляции с BottomSpace и высотой узла VT не сильно любит, т.к. вся рисовка и вызовы событий оптимизированы, да и мы не хотим в лишний раз вызывать UpdateData.
Сортировка
Немаловажная тема. Футеры должны всегда располагаться внизу своей группы. Но тут все очень просто. Нам нужно событие OnCompareNodes.
//**********************************************************************
// При сортировках футеры должны быть всегда снизу, группы сверху
//**********************************************************************
procedure TFmMain.vtvCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
begin
Result := TxIPVTVData.CompareNodes(Column,
GetIPVTVNode(Sender, Node1),
GetIPVTVNode(Sender, Node2),
(Sender.Header.SortColumn = Column) and
(Sender.Header.SortDirection = sdDescending));
end;
Пара функций из хранилища.
class function TxIPVTVData.CompareValues(const v1, v2: Variant): Integer;
begin
case VarCompareValue(v1, v2) of
vrEqual: Result := 0;
vrLessThan: Result := -1;
vrGreaterThan: Result := 1;
else Result := -1;
end;
end;
class function TxIPVTVData.CompareNodes(const AColumnIndex: Integer;
const n1, n2: TxIPVTVNode;
const AInvertIfFooter: Boolean = False): Integer;
var
i1, i2: Integer;
v1, v2: Variant;
begin
i1 := 0; v1 := NULL;
i2 := 0; v2 := NULL;
if Assigned(n1) then begin
i1 := Integer(n1.NodeType)+1;
v1 := n1.Values[AColumnIndex];
end;
if Assigned(n2) then begin
i2 := Integer(n2.NodeType)+1;
v2 := n2.Values[AColumnIndex];
end;
if AInvertIfFooter then
begin
if (i1 = Integer(xntFooter)+1) then i1 := -i1;
if (i2 = Integer(xntFooter)+1) then i2 := -i2;
end;
Result := i1 - i2;
if Result <> 0 then exit;
Result := CompareValues(v1,v2);
end;
Тут происходит простое сравнение вариантных типов. С той особенностью, что если сравнивается узел-футер и сортировка в обратной последовательности, результат сравнения меняет знак.
Предполагается, что варианты сравнения в реальной жизни могут быть значительно разнообразней. В этом случае надо менять и дописывать OnCompareNodes.
Автоматической сортировки как таковой в VT не предусмотрено, поэтому пишем это дело руками. Обрабатываем событие OnHeaderClick.
//********************************************************************
// Сортировка
//********************************************************************
procedure TFmMain.vtvHeaderClick(Sender: TVTHeader;
HitInfo: TVTHeaderHitInfo);
begin
if HitInfo.Button = mbLeft then
with Sender do
begin
SortColumn := HitInfo.Column;
if SortDirection = sdAscending then
SortDirection := sdDescending
else
SortDirection := sdAscending;
Treeview.SortTree(SortColumn, SortDirection);
end;
end;
Со свойствами, которые присутствуют в VT по умолчанию, должно работать. Иначе устанавливаем все, что связано с сортировкой.
Кратко о вышесказанном
Как уже было сказано, предлагаемое решение – это комбинация свойств и событий.
Отличный справочник по свойствам и событиям VT смотрим тут.
Обязательно должны быть
| TreeOptions.AutoOptions | toAutoSpanColumns | Позволит рисовать текст группы во всю ширину таблицы. Переносит текст, не помещающийся в данной колонке на соседнюю, если она не содержит текста |
| TreeOptions.MiscOptions | toGridExtensions | Симуляция элемента управления а-ля TDBGrid |
| TreeOptions.PaintOptions | toShowButtons | Отображать кнопки +/- напротив узлов |
| toShowVertGridLines | Отображать вертикальны линии сетки (не обязательно) Если снять опцию, просто ячейки не будут разграничены. На отображение футеров и групп не влияет | |
| toShowRoot | Учитывать отступ для самых верхних узлов первого уровня вложенности, дочерних узлов RootNode | |
| toHideFocusRect | Не рисовать прямоугольник фокуса по границам узла. | |
| toHideSelection | Не рисует бежевый прямоугольник выделения для выделенных узлов, когда само дерево не имеет фокуса. | |
| TreeOptions.SelectionOptions | toDisableDrawSelection | Запрещает пользователю добавлять в текущее выделение узлы с помощью прямоугольника выделения |
| toExtendedFocus | Позволяет выделять ячейки и редактировать текст во всех колонках, а не только в MainColumn | |
| TreeOptions.StringOptions | toShowStaticText | Включает статический текст, который отображается рядом с обычным. Используется для вывода данных футера рядом с названием группы. |
Убрать из опций обязательно
| TreeOptions.PaintOptions | toShowHorzGridLines | Горизонтальные линии будем рисовать сами |
| toShowTreeLines | Соединительные лини древа нам не нужны |
Необходимо обработать события:
| OnBeforeCellPaint | Подготовить фон для узлов. |
| OnAfterCellPaint | Рисовка групп, футеров, данных, разделительных линий. Основной отрисовщик таблицы. |
| OnMeasureItem | Высота главного футера. Вообще, высота любого узла. Допустим, захотим группы 0-го уровня сделать прям очень высокими. |
| OnAfterPaint | Позиционирование панели – главного футера |
| OnGetCellText | Вернуть VT выводимый в ячейку текст |
| OnPaintText | Графические параметры выводимого текста. |
| OnFocusChanged | Смена фокуса. Определить и при необходимости отскролировать VT так, чтобы сфокусированный узел не заходил за панель. |
| OnFocusChanging | Определить, что надо перекинуть фокус на предпоследний видимый элемент, если фокус хочет получить главный футер. |
| OnCompareNodes | Для сортировки. Сравнение значений в столбцах |
| OnHeaderClick | Клик по столбцу. Обеспечить правильную смену направления сортировки и осуществить сортировку. |
Нюансы
Помним про нюансы с BottomSpace и нулевой высотой последнего узла. Также, Margin желательно сделать нулевым. Можно сделать и отрицательным, если того требует предметная область.
Итоговый обработчик события OnAfterCellPaint
//*********************************************************************
// Основная отрисовка - рисуем группы, футеры и немного данные
//*********************************************************************
procedure TFmMain.vtvAfterCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellRect: TRect);
var
rct: TRect; // прямоугольник вывода текста ячейки футера
OffX: Integer; // отступ для каждого уровня вложенности узлов
Text: String; // текст ячейки
Curr: TxIPVTVNode; // текущий элемент хранилища
Next: TxIPVTVNode; // следующий элемент хранилища
Level: Integer; // текущий уровень
begin
// если указано рисовать верт.линии - расширяем правую границу на 1
if CheckPaintOptions(Sender, toShowVertGridLines) then
Inc(CellRect.Right);
// Предварительная инициализация
with TargetCanvas do
begin
Brush.Color := clBtnFace;
Font.Color := clWindowText;
Pen.Color := FFooterLineColor;
end;
// Получаем текущий и следющий за ним элементы хранилища
Next := nil;
Curr := GetIPVTVNode(Sender, Node);
if Assigned(Node) then
Next := GetIPVTVNode(Sender, Sender.GetNextVisible(Node));
// Это фиксированная левая часть
if Column = 0 then
begin
with TargetCanvas do
begin
// рамку рисуем всегда, в конкретных случаях всегда можно изменить
Rectangle(CellRect.Left-1, CellRect.Top-1, CellRect.Right,
CellRect.Bottom);
// это сфокусированный элемент - нарисовать маркер-треугольник
if Node = Sender.FocusedNode then
Draw(CellRect.Left + 4, CellRect.Top +
round((CellRect.Height - FMark.Height)/2), FMark);
// Самый нижний видимый элемент - подрисовать линию снизу
if (not Assigned(Sender.GetNextVisible(Node))) then
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
end;
// делать тут больше нечего
Exit;
end;
if (not Assigned(Curr))
then // делать тут больше нечего
Exit;
rct := CellRect;
OffX := GetTreeIndent(Sender);
Level := Sender.GetNodeLevel(Node);
with TargetCanvas do
begin
Brush.Style := bsSolid;
// Рисуем горизонтальные линии ячейки данных
if (Curr.NodeType = xntData) then
begin
if Assigned(Next) and (Next.NodeType in [xntGroup, xntFooter])
then // подо мной серьезные ноды, подчеркнем этот факт
Pen.Color := FFooterLineColor
else // подо мной такие же ноды, равенство в цвете
Pen.Color := FDataLineColor;
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
end;
Pen.Color := FFooterLineColor;
// Рисуем футер: фон, текст, нажнюю и правую границы
if (Curr.NodeType = xntFooter) then
begin
Text := Curr[Column];
FillRect(CellRect);
// Если это "древовидный" столбец, считаем левую границу
if Column = Sender.Header.MainColumn then
rct.Left := rct.Left + OffX*Level;
InflateRect(rct, -4, 0);
DrawTextEx(TargetCanvas, rct, Text, slCenter,
FData.Columns[Column].FooterAlignment);
// Нижняя и правая границы ячейки
HorzLine(TargetCanvas, CellRect.Left, CellRect.Right,
CellRect.Bottom-1);
if FData.Columns[Column].DrawFooterVertLine then
VertLine(TargetCanvas, CellRect.Right-1, CellRect.Top,
CellRect.Bottom);
end;
if (Column = Sender.Header.MainColumn) then
begin
// Нарисовать/раскрасить уровни "до меня" (касается всех узлов)
VTDrawLevels(TargetCanvas, CellRect, Sender, Level-1,
GetLevelColor);
// Нижние границы для групп и футеров
if Curr.NodeType in [xntGroup, xntFooter] then
begin
// Если раскрыт и имеет чилдов, смещаем начало вправо на OffX
if (vsHasChildren in Node.States) and (vsExpanded in Node.States)
then
Level := Level + 1
else //Если последний в группе, линия начинается левее
if NodeIsLast(Sender, Node) then
Level := Level - 1;
// Нижняя линия
HorzLine(TargetCanvas, CellRect.Left + Level*OffX - 1,
CellRect.Right, CellRect.Bottom - 1);
// Правая закрывающая линия для группы
if Curr.NodeType = xntGroup then
VertLine(TargetCanvas, CellRect.Right-1, CellRect.Top,
CellRect.Bottom);
end;
end;
// Правая закрывающая линия для последнего видимого столбца
if ((Curr.NodeType in [xntFooter]) and
(Sender.Header.Columns.GetLastVisibleColumn = Column))
then
VertLine(TargetCanvas, CellRect.Right-1, CellRect.Top,
CellRect.Bottom);
end;
end;
Ничто не совершенно
В этом вся и прелесть. Допустим, некоторые вещи делать не стал, чтобы не перегружать и так объемную статью и демо-пример.
- Клавиши вправо/влево – раскрывают/сворачивают группу. Сейчас этого нет, а прям просится.
- Если на группе нажать вправо, или фокус не на главном столбце, выделение группы пропадет, можно доработать. Можно вообще другой цвет какой-то использовать. Одним словом, творчество.
- При фокусе на футере выделение не показано никак, кроме маркера слева. Также, просится доработка.
- Можно сделать опционально запрет перевода фокуса на футеры, т.е. проскакивать до данных. Это событие OnFocusChanging. Только надо анализировать последний футер, иначе до последних футеров можно будет добраться только мышкой.
- Футеры также можно градировать, но может и мазня пестрая получится. Требуются эксперименты и чувство прекрасного )
Друзья, спасибо за внимание!
Информация о новых статьях смотрим в телеграм-канале.
Не забываем комментировать и подписываться )))
Скачать (344 Кб): Исходники (Delphi XE 7-10)
Скачать (823 Кб): Исполняемый файл
Вот блин, ну всё прекрасно, кроме того, что картинки мелкие и их нельзя увеличить кликом!
Ох, какое хорошее замечание. Совсем не подумал об этом. Спасибо! Сделал пока только для этой статьи. Надеюсь, стало лучше.
Вот теперь отлично, спасибо!
Жду новых статей, очень понравился стиль и подход к их написанию 🙂
PS Что-то, несмотря на чекнутую галку «Сохранить моё имя, email и адрес сайта в этом браузере для последующих моих комментариев», они не сохранились, приходится вводить еще раз 🙁
Спасибо на добром слове )
Стараюсь, чтобы и читалось легко, и польза была.
Поэтому статьи появляются не часто.
В планах много их. А времени не хватает.
С галкой буду разбираться.