Embedding a VirtualTreeView Button in Cells

Question

Embedding a VirtualTreeView Button in Cells

I am trying to create a node with TButton. I Create a node and buttons associated with nodes. In the TVirtualStringTree.AfterCellPaint event, I initialize the BoundsRect on the button. But the button is always displayed in the first node.

Do you have any idea about 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;

+4

delphi virtualtreeview

r038tmp5 Feb 18 '15 at 8:51

source share

3 answers

hzzmj · Answer 1 · 2016-09-02T07:51:59+0000

, iamjoosy - - , // , , , , / , . , , . AfterCellPaint , Node / .

, (, , ) , (, , ) / :

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;

, OnEvents. AfterCellPaint; , .

RunTime + Button, ButtonArray , , RTTI. http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.zip ( RTTI http://www.blong.com/Conferences/BorConUK98/DelphiRTTI/CB140.htm) " 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;

, VisibilityCheck, :

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

kobik · Answer 2 · 2017-06-02T10:06:51+0000

node. , OnAfterPaint. , .

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

:

Delphi 7, VT 5.3.0, Windows 7

iamjoosy · Answer 3 · 2015-02-18T12:45:37+0000

The coordinates of the CellRect parameter in the OnAfterCellPaint event handler refer to the node drawing. What you need is the absolute position of the node in the tree window. You can get this by calling GetDisplayRect of the tree. Therefore, change your code as follows:

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;

Run code Hide result

Embedding a VirtualTreeView Button in Cells

More articles: