VirtualTreeView embedding button in the cells - delphi

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

Answer 3

The coordinates of the CellRect parameter in the OnAfterCellPaint event handler are relative to the drawn node. What you need is the absoulte position of the node within the tree window. You can obtain that by calling GetDisplayRect of the tree.
So change your code like this:
procedure TForm1.VirtualStringTree1AfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
var
NodeData: PNodeData;
R: TRect;
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));
R := Sender.GetDisplayRect(Node, Column, False);
BoundsRect := R;
end;
end;
end;