Все мы знаем и любим 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, как динамическая инициализация данных. Так или иначе, нам нужны сразу все данные, иначе не получится правильно ни сгруппировать, ни агрегировать.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
//********************************************************************* // обновить данные в дереве //********************************************************************* 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 делаем так.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
//******************************************************************** // Получить элемент указанного класса из указанного узла //******************************************************************** 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.
Далее, нам понадобится разный цвет для групп разного уровня.
|
1 2 3 4 5 6 7 8 |
//******************************************************************** // Получить цвет уровня //******************************************************************** function TFmMain.GetLevelColor(Sender: TBaseVirtualTree; ALevel: Integer): TColor; begin Result := Lighter(clLevelColor, ALevel * FLevelColorIndent); end; |
Далее, обработаем событие OnBeforeCellPaint. В нем нам нужно указать цвет фона для будущей отрисовки содержимого узла.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
//******************************************************************** // "Красим" подложку //******************************************************************** 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. Первое отвечает за выводимый в ячейку текст, второе за графические параметры отображения текста.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
//******************************************************************** // Получить текст для отображения в гриде //******************************************************************** 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 видим, как это должно выглядеть.
Разноцветные уровни групп
Создать иллюзию непрерывности можно рисуя в каждой ячейке «древовидного» столбца вертикальные полосы цветом уровня группы. Для определения цвета у нас уже есть функция. Предлагается следующая функция для отрисовки этих полос.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
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. В нем пишем следующее.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
//******************************************************************** // Поэтапная отрисовка древа //******************************************************************** 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; |
Сейчас будем постепенно добавлять функционал в этот обработчик.
Рисуем футер
С футером все просто на самом деле. Градировать пока не требуется, это уж на усмотрение программиста или заказчика. Просто закрасим поле футера нужным цветом. Вставим этот фрагмент перед рисованием полос:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
// Рисуем поле футера для всех столбцов кроме нулевого 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 эффект видим сразу.
|
1 2 3 |
if CheckPaintOptions(AVT, toShowVertGridLines) then VertLine(ACanvas, rct.Right-1, rct.Top, rct.Bottom); |
Однако, возникает вопрос — как посчитать левую координату прочих линий. Как видно на рисунке 9, в зависимости от ситуации, координата должна быть разная. В одних случаях отстоять на определенный интервал от предыдущей линии, в других пересекать ее.
Вначале рисуем лини для ячеек. Там все просто, единственное что, для последней ячейки перед футером меняем цвет пера.
Этот фрагмент кода разместим перед рисованием футера. Нулевой столбец не трогаем, для него отдельная рисовка.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
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; |
Для разграничения групп и футеров используем такой код. Вставляем в конец обработчика, после всех отрисовок. Для определения левой координаты линии нас интересует только главный «древовидный» столбец. В конце рисуем вертикальную закрывающую линию.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
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 и иже с ним. Подготовим где-нибудь ранее битмап маркера треугольника.
|
1 2 3 4 5 6 7 8 9 10 11 12 |
// Создаем треугльник слева - маркер текущей строки 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; |
Нарисуем нулевой столбец. Разместим этот фрагмент вначале всех рисовок в обработчике.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
//******************************************************************** // Высота главного футера //******************************************************************** 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 посчитаем где-то раньше. У меня это так:
|
1 2 3 |
// Варианты высоты главного футера FBottomSpace := round(vtv.Header.Height*1.3); |
Далее обработаем событие OnAfterPaint, где будем позиционировать панель в необходимое место.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
//******************************************************************** // Определить текущее положение глобального футера и // установить позицию панели //******************************************************************** 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 которого есть вызов функции рисовки футера.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 |
//******************************************************************** // Нарисовать футер //******************************************************************** 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 (собираюсь сменить фокус – можно?)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
//*********************************************************************** // Фокус изменился – определить, надо ли и если надо - скролировать //*********************************************************************** 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. Там есть такая запись:
|
1 2 3 4 5 |
if pnlFooter.Visible then NodeHeight := 0 else NodeHeight := FBottomSpace; |
То есть, если главный футер-панель видим, высота узла главного футера становится равной нулю. Конечно, при обработке OnFocusChanging в этом случае, фокус, переходя на предпоследний узел, все равно спрячет этот узел под панель. Вот чтобы этого не было, используем свойство BottomSpace. Это свойство задает видимое пространство под последним узлом.
Как уже говорилось, за показ главного футера панели отвечает галочка в интерфейсе. И в ее обработчике есть такой фрагмент:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
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 следующей функцией.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
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, в которой указывается – добавлять или нет главный футер?
|
1 2 3 |
UpdateDataTree(const ATree: TBaseVirtualTree; const AData: TxIPVTVData; const AWithMainFooter: Boolean = True) |
Дело в том, что если вдруг (т.е. скорее всего) нам лень делать экспорт своими руками и хотим все сделать средствами VT, узел главного футера нам все таки нужен.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 |
//********************************************************************** // При сортировках футеры должны быть всегда снизу, группы сверху //********************************************************************** 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; |
Пара функций из хранилища.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
//******************************************************************** // Сортировка //******************************************************************** 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
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 |
//********************************************************************* // Основная отрисовка - рисуем группы, футеры и немного данные //********************************************************************* 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 и адрес сайта в этом браузере для последующих моих комментариев», они не сохранились, приходится вводить еще раз 🙁
Спасибо на добром слове )
Стараюсь, чтобы и читалось легко, и польза была.
Поэтому статьи появляются не часто.
В планах много их. А времени не хватает.
С галкой буду разбираться.