VirtualTreeView embedding button in the cells

Question

I'm trying to create node with TButton. I Create the node and the buttons linked to the nodes. On the event TVirtualStringTree.AfterCellPaint, I initialise the BoundsRect on the button. But the button is always shown in the first node.

Have you some idea of the problem?

type
  TNodeData = record
    TextValue: string;
    Button: TButton;
  end;
  PNodeData = ^TNodeData;

procedure TForm1.FormCreate(Sender: TObject);

  procedure AddButton(__Node: PVirtualNode);
  var
    NodeData: PNodeData;
  begin
    NodeData := VirtualStringTree1.GetNodeData(__Node);
    NodeData.Button := TButton.Create(nil);
    with NodeData.Button do
    begin
      Parent := VirtualStringTree1;
      Height := VirtualStringTree1.DefaultNodeHeight;
      Caption := '+';
      Visible := false;
    end;
  end;

  procedure InitializeNodeData(__Node: PVirtualNode; __Text: string);
  var
    NodeData: PNodeData;
  begin
    NodeData := VirtualStringTree1.GetNodeData(__Node);
    NodeData.TextValue := __Text;
  end;

var
  Node: PVirtualNode;
begin
  VirtualStringTree1.NodeDataSize := SizeOf(TNodeData);

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node, 'a');      
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node, 'a.1');

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node, 'b');
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node, 'Here the button');
  AddButton(Node);
end;

procedure TForm1.VirtualStringTree1AfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
var
 NodeData: PNodeData;
begin
  if (Column = 0) then
    Exit;

  NodeData := VirtualStringTree1.GetNodeData(Node);
  if (Assigned(NodeData)) and (Assigned(NodeData.Button)) then
  begin
    with NodeData.Button Do
    begin
      Visible := (vsVisible in Node.States)
                 and ((Node.Parent = VirtualStringTree1.RootNode) or   (vsExpanded in Node.Parent.States));
      BoundsRect := CellRect;
    end;
  end;
end;

Answer 1

So the problem with iamjoosy's answer is - even though it works - that as soon as you scroll through this Tree with the drawn buttons/images/whatever, the ones that are supposed to leave the Tree again are still existing, being painted at the lowest/highest location where you left them off. Depending on the amount you just scrolled, it leaves a smaller or larger clutter of buttons in that column. AfterCellPaint doesn't move them anymore, since the cells of that now invisble Node below the bottom/above the top are not painted anymore.

What you can do is traverse all tree nodes (probably very expensive if you have a lot of nodes) and check if they are actually in the visible area of the tree and hide the panels (you might need your buttons inside panels to be painted on top of the tree instead of behind) with your buttons/whatevers accordingly:

procedure TMyTree.MyTreeAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellRect: TRect);
var
  InitialIndex: Integer;
// onInitNode I AddOrSetValue a "DataIndexList" TDictionary<PVirtualNode, LongInt>
// to preserve an original index "InitialIndex" (violating the virtual paradigm),
// because I need it for something else anyways
  Data: PMyData;
  ANode: PVirtualNode;
begin
  if Node <> nil then
  begin
    if Column = 2 then
    begin
      ANode := MyTree.GetFirst;
      while Assigned(ANode) do
      begin
        DataIndexList.TryGetValue(ANode, InitialIndex);
        if not ( CheckVisibility(Sender.GetDisplayRect(ANode, Column, False)) ) then
        begin
          MyBtnArray[InitialIndex].Visible := False;
          MyPanelArray[InitialIndex].Visible := False;
        end
        else
        begin
          MyBtnArray[InitialIndex].Visible := True;
          MyPanelArray[InitialIndex].Visible := True;
        end;
        ANode := MyTree.GetNext(ANode);
      end;
      DataIndexList.TryGetValue(Node, InitialIndex);
      Data := MyTree.GetNodeData(Node);
      MyPanelArray[InitialIndex].BoundsRect := Sender.GetDisplayRect(Node, Column, False);
    end;
  end;
end;

function TMyTree.CheckVisibility(R: TRect): Boolean;
begin
// in my case these checks are the way to go, because
// MyTree is touching the top border of the TForm.  You will have
// to adjust accordingly if your placement is different
  if (R.Bottom < MyTree.Top) or (R.Bottom > MyTree.Top + MyTree.Height) then
    Result := False
  else
    Result := True;
end;

Needless to say that you can do the traversing with visibilityCheck inside many other OnEvents successfully. It doesn't have to be in AfterCellPaint; maybe another event might be a lot better performance wise.

To create RunTime copies of your one original Panel+Button, to place inside your ButtonArray or whichever structure you're using, you will have to copy their RTTI as well. This procedure is taken from http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.zip (further RTTI information at http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm) and "uses TypInfo":

procedure CopyObject(ObjFrom, ObjTo: TObject);
var
  PropInfos: PPropList;
  PropInfo: PPropInfo;
  Count, Loop: Integer;
  OrdVal: Longint;
  StrVal: String;
  FloatVal: Extended;
  MethodVal: TMethod;
begin
  { Iterate thru all published fields and properties of source }
  { copying them to target }

  { Find out how many properties we'll be considering }
  Count := GetPropList(ObjFrom.ClassInfo, tkAny, nil);
  { Allocate memory to hold their RTTI data }
  GetMem(PropInfos, Count * SizeOf(PPropInfo));
  try
    { Get hold of the property list in our new buffer }
    GetPropList(ObjFrom.ClassInfo, tkAny, PropInfos);
    { Loop through all the selected properties }
    for Loop := 0 to Count - 1 do
    begin
      PropInfo := GetPropInfo(ObjTo.ClassInfo, PropInfos^[Loop]^.Name);
      { Check the general type of the property }
      { and read/write it in an appropriate way }
      case PropInfos^[Loop]^.PropType^.Kind of
        tkInteger, tkChar, tkEnumeration,
        tkSet, tkClass{$ifdef Win32}, tkWChar{$endif}:
        begin
          OrdVal := GetOrdProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetOrdProp(ObjTo, PropInfo, OrdVal);
        end;
        tkFloat:
        begin
          FloatVal := GetFloatProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetFloatProp(ObjTo, PropInfo, FloatVal);
        end;
        {$ifndef DelphiLessThan3}
        tkWString,
        {$endif}
        {$ifdef Win32}
        tkLString,
        {$endif}
        tkString:
        begin
          { Avoid copying 'Name' - components must have unique names }
          if UpperCase(PropInfos^[Loop]^.Name) = 'NAME' then
            Continue;
          StrVal := GetStrProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetStrProp(ObjTo, PropInfo, StrVal);
        end;
        tkMethod:
        begin
          MethodVal := GetMethodProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetMethodProp(ObjTo, PropInfo, MethodVal);
        end
      end
    end
  finally
    FreeMem(PropInfos, Count * SizeOf(PPropInfo));
  end;
end;

Seeing this old answer of mine later, I now have a different solution running for the VisibilityCheck, which is a lot more reliable and easier:

function TFoo.IsNodeVisibleInClientRect(Node: PVirtualNode; Column: TColumnIndex = NoColumn): Boolean;
begin
  Result := VST.IsVisible[Node] and
    VST.GetDisplayRect(Node, Column, False).IntersectsWith(VST.ClientRect);
end;

Answer 2

I wrote a small program to create any control for a node. I found out that the best place to set the nodes control visibility it in OnAfterPaint event. The scrolling works as intended and there is almost zero flickering.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    VirtualStringTree1: TVirtualStringTree;
    procedure FormCreate(Sender: TObject);            
    procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure VirtualStringTree1AfterPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas);
    procedure VirtualStringTree1MeasureItem(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);  
  private
    procedure SetNodesControlVisibleProc(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
    procedure SetNodeControlVisible(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex = NoColumn);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TNodeData = record
    Text: WideString;
    Control: TControl;
  end;
  PNodeData = ^TNodeData;

{ Utility }
function IsNodeVisibleInClientRect(Tree: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex = NoColumn): Boolean;
var
  OutRect: TRect;
begin
  Result := Tree.IsVisible[Node] and
    Windows.IntersectRect(OutRect, Tree.GetDisplayRect(Node, Column, False), Tree.ClientRect);
end;

type
  TControlClass = class of TControl;

  TMyPanel = class(TPanel)
  public
    CheckBox: TCheckBox;
  end;

{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);

  function CreateNodeControl(Tree: TVirtualStringTree; Node: PVirtualNode; ControlClass: TControlClass): TControl;
  var
    NodeData: PNodeData;
  begin
    NodeData := Tree.GetNodeData(Node);
    NodeData.Control := ControlClass.Create(nil);
    with NodeData.Control do
    begin
      Parent := Tree; // Parent will destroy the control
      Height := Tree.DefaultNodeHeight;
      Visible := False;
    end;
    Tree.IsDisabled[Node] := True;
    Result := NodeData.Control;
  end;

  procedure InitializeNodeData(Node: PVirtualNode; const Text: WideString);
  var
    NodeData: PNodeData;
  begin
    NodeData := VirtualStringTree1.GetNodeData(Node);
    Initialize(NodeData^);
    NodeData.Text := Text;
  end;

var
  Node: PVirtualNode;
  MyPanel: TMyPanel;
  I: integer;
begin
  VirtualStringTree1.NodeDataSize := SizeOf(TNodeData);
  // trigger MeasureItem
  VirtualStringTree1.TreeOptions.MiscOptions := VirtualStringTree1.TreeOptions.MiscOptions + [toVariableNodeHeight]; 

  // Populate some nodes    
  for I := 1 to 5 do begin
    Node := VirtualStringTree1.AddChild(nil);
    InitializeNodeData(Node, Format('%d', [I]));
    Node := VirtualStringTree1.AddChild(Node);
    InitializeNodeData(Node, Format('%d.1', [I]));
  end;

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node, '[TSpeedButton Parent]');
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node, 'TSpeedButton');
  TSpeedButton(CreateNodeControl(VirtualStringTree1, Node, TSpeedButton)).Caption := '+';

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node, '[TEdit Parent]');
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node, 'TEdit');
  TEdit(CreateNodeControl(VirtualStringTree1, Node, TEdit)).Text := 'Hello';

  Node := VirtualStringTree1.AddChild(nil);
  InitializeNodeData(Node, '[TMyPanel Parent]');
  Node := VirtualStringTree1.AddChild(Node);
  InitializeNodeData(Node, 'TMyPanel');
  MyPanel := TMyPanel(CreateNodeControl(VirtualStringTree1, Node, TMyPanel));
  with MyPanel do
  begin
    Caption := 'TMyPanel';
    ParentBackground := False;
    CheckBox := TCheckBox.Create(nil);
    CheckBox.Caption := 'CheckBox';
    CheckBox.Left := 10;
    CheckBox.Top := 10;
    CheckBox.Parent := MyPanel;
  end;

  for I := 6 to 10 do begin
    Node := VirtualStringTree1.AddChild(nil);
    InitializeNodeData(Node, Format('%d', [I]));
    Node := VirtualStringTree1.AddChild(Node);
    InitializeNodeData(Node, Format('%d.1', [I]));
  end;
end;

procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  NodeData: PNodeData;
begin
  NodeData := Sender.GetNodeData(Node);
  if Assigned(NodeData) then
    CellText := NodeData.Text;
end;

procedure TForm1.SetNodeControlVisible(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex = NoColumn);
var
  NodeData: PNodeData;
  R: TRect;
begin
  NodeData := Tree.GetNodeData(Node);
  if Assigned(NodeData) and Assigned(NodeData.Control) then
  begin
    with NodeData.Control do
    begin
      Visible := IsNodeVisibleInClientRect(Tree, Node, Column)
                 and ((Node.Parent = Tree.RootNode) or (vsExpanded in Node.Parent.States));
      R := Tree.GetDisplayRect(Node, Column, False);
      BoundsRect := R;
    end;
  end;
end;

procedure TForm1.SetNodesControlVisibleProc(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
begin
  SetNodeControlVisible(Sender, Node);
end;

procedure TForm1.VirtualStringTree1AfterPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas);
begin
  // Iterate all Tree nodes and set visibility
  Sender.IterateSubtree(nil, SetNodesControlVisibleProc, nil);
end;

procedure TForm1.VirtualStringTree1MeasureItem(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
var
  NodeData: PNodeData;
begin
  NodeData := Sender.GetNodeData(Node);
  if Assigned(NodeData) and Assigned(NodeData.Control) then
  // set node special height if control is TMyPanel
    if NodeData.Control is TMyPanel then
      NodeHeight := 50;
end;

end.

DFM:

object Form1: TForm1
  Left = 192
  Top = 124
  Width = 782
  Height = 365
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  DesignSize = (
    766
    327)
  PixelsPerInch = 96
  TextHeight = 13
  object VirtualStringTree1: TVirtualStringTree
    Left = 8
    Top = 8
    Width = 450
    Height = 277
    Anchors = [akLeft, akTop, akRight, akBottom]
    Header.AutoSizeIndex = 0
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'MS Sans Serif'
    Header.Font.Style = []
    Header.MainColumn = -1
    TabOrder = 0
    OnAfterPaint = VirtualStringTree1AfterPaint
    OnGetText = VirtualStringTree1GetText
    OnMeasureItem = VirtualStringTree1MeasureItem
    Columns = <>
  end
end

Output:

Tested with Delphi 7, VT version 5.3.0, Windows 7