VirtualTreeView Footers

Все мы знаем и любим 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 смотрим тут.

Обязательно должны быть

Убрать из опций обязательно

Необходимо обработать события:

Нюансы

Помним про нюансы с 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;

Ничто не совершенно

В этом вся и прелесть. Допустим, некоторые вещи делать не стал, чтобы не перегружать и так объемную статью и демо-пример.

1. Клавиши вправо/влево – раскрывают/сворачивают группу. Сейчас этого нет, а прям просится.
2. Если на группе нажать вправо, или фокус не на главном столбце, выделение группы пропадет, можно доработать. Можно вообще другой цвет какой-то использовать. Одним словом, творчество.
3. При фокусе на футере выделение не показано никак, кроме маркера слева. Также, просится доработка.
4. Можно сделать опционально запрет перевода фокуса на футеры, т.е. проскакивать до данных. Это событие OnFocusChanging. Только надо анализировать последний футер, иначе до последних футеров можно будет добраться только мышкой.
5. Футеры также можно градировать, но может и мазня пестрая получится. Требуются эксперименты и чувство прекрасного )

Друзья, спасибо за внимание!

Информация о новых статьях смотрим в телеграм-канале.

Не забываем комментировать и подписываться )))

Скачать (344 Кб): Исходники (Delphi XE 7-10)

Скачать (823 Кб): Исполняемый файл

5 1 голос

Рейтинг статьи

Подписаться

авторизуйтесь

Уведомить о

новых последующих комментариях новых ответах на мои комментарии

{} [+]

Имя*

Email*

Веб-сайт

{} [+]

Имя*

Email*

Веб-сайт

4 комментариев

Старые

Новые Популярные

Межтекстовые Отзывы

Посмотреть все комментарии

Vad

2 месяцев назад

Вот блин, ну всё прекрасно, кроме того, что картинки мелкие и их нельзя увеличить кликом!

1

Ответить

Roman

Автор

Ответить на  Vad

1 месяц назад

Ох, какое хорошее замечание. Совсем не подумал об этом. Спасибо! Сделал пока только для этой статьи. Надеюсь, стало лучше.

0

Ответить

Vad

Ответить на  Roman

1 месяц назад

Вот теперь отлично, спасибо!
Жду новых статей, очень понравился стиль и подход к их написанию 🙂

PS Что-то, несмотря на чекнутую галку «Сохранить моё имя, email и адрес сайта в этом браузере для последующих моих комментариев», они не сохранились, приходится вводить еще раз 🙁

0

Ответить

Roman

Автор

Ответить на  Vad

1 месяц назад

Спасибо на добром слове )
Стараюсь, чтобы и читалось легко, и польза была.
Поэтому статьи появляются не часто.
В планах много их. А времени не хватает.
С галкой буду разбираться.

0

Ответить