I am using Delphi XE3 with Virtual Tree View.
My codes are below:
type
TMyData = record
Caption: string;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
RootNode: PVirtualNode;
PData: ^TMyData;
begin
RootNode := tvItems.AddChild(nil);
PData := tvItems.GetNodeData(RootNode);
PData^.Caption := 'This is a test node';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
tvItems.NodeDataSize := SizeOf(TMyData);
end;
procedure TForm1.tvItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
PData: ^TMyData;
begin
if Assigned(Node) then
begin
PData := tvItems.GetNodeData(Node);
if Assigned(PData) then
Celltext := PData^.Caption;
end;
end;
When I click the "Button1", the root node will be created. However, when my mouse clicks the node text, it will not be selected.
Some of my findings:
One must clicks to the beginning of the node text to select the node. If clicking in middle or in the end of the node text, then the node will not be selected.
If I change tvItemsGetText to below, then the problem disappears:
procedure TForm1.tvItemsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
PData: ^TMyData;
begin
CellText := 'This is a test node';
end;
I set a breakpoint in tvItemsGetText and find it will be invoked several times. At the first several times, the PData will be nil, which makes the CellText empty. At the final invokation, the PData will become valid and the CellText will be set to 'This is a test node'.
It seems that the range that allow mouse click and select the node is determined by the initial texts of the node. If the initial text is empty string, then one must click at the very beginning of the node to select it.
Is this a bug of Virtual Tree View?
There are several ways to init new node by user data.
1. Using OnInitNode event:
procedure TForm5.Button1Click(Sender: TObject);
begin
vt1.InsertNode(nil, amAddChildLast); // internal calls vt1InitNode
end;
procedure TForm5.vt1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
var InitialStates: TVirtualNodeInitStates);
var
PData: ^TMyData;
begin
PData := Sender.GetNodeData(Node);
PData^.Caption := 'This is a test node';
end;
2 Using UserData param
Variant 1. Dynamic data
Do not forget to remove InitNode event and dont set NodeDataSize property
type
TMyData = record
Caption: string;
end;
PMyData = ^TMyData;
procedure TForm5.Button1Click(Sender: TObject);
var
p: PMyData;
begin
New(p);
p.Caption:='This is a test node';
vt1.InsertNode(nil, amAddChildLast, p); // create node with initialized user data
// by default VirtualTree use NodeDataSize = SizeOf(pointer),
// so there is no reason to use GetNodeDataSize event
end;
procedure TForm5.vt1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
PData: PMyData;
begin
if Assigned(Node) then
begin
PData := PMyData(Sender.GetNodeData(Node)^); // little modification
// for correct access to dynamic node data
if Assigned(PData) then
CellText := PData.Caption;
end;
end;
procedure TForm5.vt1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
p: PMyData;
begin
p:=PMyData(Sender.GetNodeData(Node)^);
Dispose(p); // as you allocate memory for user data - you should free it to avoid memory leaks
end;
Variant 2. Objects
Add new private function to your form:
private
{ Private declarations }
function GetObjectByNode<T: class>(Node: PVirtualNode): T;
// do not forget to include System.Generics.Collections to `uses`
realization:
function TForm5.GetObjectByNode<T>(Node: PVirtualNode): T;
var
NodeData: Pointer;
tmpObject: TObject;
begin
Result := nil;
if not Assigned(Node) then
exit;
NodeData := vt1.GetNodeData(Node);
if Assigned(NodeData) then
tmpObject := TObject(NodeData^);
if tmpObject is T then
Result := T(tmpObject)
else
Result := nil;
end;
And the main code (almost identical to variant 1):
procedure TForm5.Button1Click(Sender: TObject);
var
d: TMyData;
begin
d := TMyData.Create;
d.Caption := 'This is a test node';
vt1.InsertNode(nil, amAddChildLast, d);
end;
procedure TForm5.vt1FreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
d: TMyData;
begin
d := GetObjectByNode<TMyData>(Node);
d.Free;
end;
procedure TForm5.vt1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
d: TMyData;
begin
d := GetObjectByNode<TMyData>(Node);
if Assigned(d) then
CellText := d.Caption;
end;
How to copy all columns between two VirtualTreeView? In my case only the first one is copied.
I use VirtualTreeView v6.6.
The code that I'm using:
type
PItemNode1 = ^TItemNode1;
TItemNode1 = record
Name: WideString;
Order: string;
Quantity:String;
end;
type
PItemNode2 = ^TItemNode2;
TItemNode2 = record
Name: WideString;
Order: string;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Node: PVirtualNode;
begin
VT.NodeDataSize := SizeOf(TItemNode1);
VT2.NodeDataSize := SizeOf(TItemNode2);
VT.RootNodeCount := 2;
VT2.RootNodeCount := 10;
end;
Procedure for inserting OLE data
procedure TForm1.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject;
Formats: TFormatArray; Effect: Integer; Mode: TVTNodeAttachMode);
var
FormatAccepted: Boolean;
i: Integer;
begin
FormatAccepted := false;
for i := 0 to High(Formats) do
begin
if Formats[i] = CF_VIRTUALTREE then
begin
if not FormatAccepted then
begin
Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode);
FormatAccepted := True;
end;
end;
end;
end;
Drag and Drop precedures
procedure TForm1.VT2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
procedure TForm1.VT2DragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure DetermineEffect;
begin
if Shift = [] then
begin
if Source = Sender then
Effect := DROPEFFECT_MOVE
else
Effect := DROPEFFECT_COPY;
end
else
begin
if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then
Effect := DROPEFFECT_LINK
else if Shift = [ssCtrl] then
Effect := DROPEFFECT_COPY
else
end;
end;
var
Attachmode: TVTNodeAttachMode;
Nodes: TNodeArray;
i: Integer;
begin
Nodes := nil;
case Mode of
dmAbove:
Attachmode := amInsertBefore;
dmOnNode:
Attachmode := amAddChildLast;
dmBelow:
Attachmode := amInsertAfter;
else
Attachmode := amNowhere;
end;
if DataObject = nil then
begin
//VCL
if Source is TVirtualStringTree then
begin
DetermineEffect;
Nodes := VT2.GetSortedSelection(True);
if Effect = DROPEFFECT_COPY then
begin
for i := 0 to High(Nodes) do
VT2.CopyTo(Nodes[i], Sender.DropTargetNode, Attachmode, false);
end
else
for i := 0 to High(Nodes) do
VT2.MoveTo(Nodes[i], Sender.DropTargetNode, Attachmode, false);
end;
end
else
begin
// OLE drag&drop.
if Source is TBaseVirtualTree then
DetermineEffect
else
begin
if Boolean(Effect and DROPEFFECT_COPY) then
Effect := DROPEFFECT_COPY
else
Effect := DROPEFFECT_MOVE;
end;
InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect,
Attachmode);
end;
end;
procedure TForm1.VT2DragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
// Return True, if AParent - child node of ANode.
function IsNodeParent(AParent, ANode: PVirtualNode): Boolean;
var
NextParent: PVirtualNode;
begin
NextParent := AParent;
repeat
NextParent := NextParent.Parent;
until (NextParent = Sender.RootNode) or (NextParent = nil) or
(NextParent = ANode);
Result := ANode = NextParent;
end;
var
i: Integer;
Nodes: TNodeArray;
begin
Accept := True;
if (Assigned(Sender.DropTargetNode)) and
(Sender.DropTargetNode <> Sender.RootNode) then
Nodes := (Sender as TVirtualStringTree).GetSortedSelection(True);
if Length(Nodes) > 0 then
begin
for i := 0 to Length(Nodes) - 1 do
begin
Accept :=
(not IsNodeParent(Sender.DropTargetNode, Nodes[i]))
and (not(Sender.DropTargetNode = Nodes[i]));
if not Accept then Exit;
end;
end;
end;
Initialize the nodes of VT2(right VT in the picture above )and get the text for them
procedure TForm1.VT2GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
ItemNode: PItemNode2;
begin
ItemNode := Sender.GetNodeData(Node);
if Assigned(ItemNode) then
begin
case Column of
0:
CellText := ItemNode^.Name;
1:
CellText := ItemNode^.Order;
end;
end;
end;
procedure TForm1.VT2InitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
ItemNode: PItemNode2;
begin
ItemNode := Sender.GetNodeData(Node);
if Assigned(ItemNode) then
if Length(ItemNode^.Name) = 0 then
ItemNode^.Name := 'Node Index № ' + IntToStr(Node.Index);
ItemNode^.Order := IntToStr(Node.Index);
end;
Get a new text after the node is dropped
procedure TForm1.VT2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: string);
var
ItemNode: PItemNode2;
begin
ItemNode := Sender.GetNodeData(Node);
if Assigned(ItemNode) then
begin
case Column of
0:
ItemNode^.Name := NewText;
1:
ItemNode^.Order := NewText; // I've checked this line in the debugger. It is skipped
end;
end;
end;
Initialize the nodes of VT(left VT in the picture above )and get the text for them
procedure TForm1.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
ItemNode: PItemNode1;
begin
ItemNode := Sender.GetNodeData(Node);
if Assigned(ItemNode) then
case Column of
0:
CellText := ItemNode^.Name;
1:
CellText := ItemNode^.Order;
end;
end;
procedure TForm1.VTInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
ItemNode: PItemNode1;
begin
ItemNode := Sender.GetNodeData(Node);
if Assigned(ItemNode) then
if Length(ItemNode^.Name) = 0 then
ItemNode^.Name := 'VT1_Node № ' + IntToStr(Node.Index);
ItemNode^.Order := IntToStr(Node.Index);
end;
end.
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;
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;
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
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;
I'm editing the 2nd column of a displayed node in the TVirtualStringTree. However after the edit is complete it I'm unable to retrieve the text using Sender.GetNodeData(Node) - it contains no text.
How can I get the text in the OnEdited event? Is there some other way to get the edited text? I've read the first few FAQ pages of the Virtual Treeview CHM help documentation and also refered to the answer in this SO question but could not find the answer.
Here is the present code:
TTherapData = record
TherapID: Integer;
TherapName: String[120];
TherapInstr: String[120];
Selected: Byte;
end;
PTherapData = ^TTherapData;
procedure TfmPatient_Conslt.vstRxList_AsgEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
var
TherapData: PTherapData;
begin
TherapData := Sender.GetNodeData(Node);
if Assigned(TherapData) then
begin
TherapData^.TherapInstr := vstRxList_Asg.Text[Node, 1];
showmessage(TherapData^.TherapInstr);
end;
FTherapDataListAsg_Iter := 0;
vstRxList_Asg.NodeDataSize := SizeOf(TTherapData);
vstRxList_Asg.RootNodeCount := 0;
vstRxList_Asg.RootNodeCount := TherapDataList_CountSelectedItems;
end;
Thanks to hint from TLama, the answer is to handle the OnNewText event:
procedure TfmPatient_Conslt.vstRxList_AsgNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
NewText: string);
var
TherapData: PTherapData;
begin
if (Column = 1) then
begin
TherapData := Sender.GetNodeData(Node);
if Assigned(TherapData) then
TherapData^.TherapInstr := NewText;
end;
end;
Here is what I am "trying" to achieve
I have a function to generate passwords which I then add into a TStringList after this I should populate the VirtualTreeView with the items but I am having no luck in getting anywhere fast with doing so. How should it be done the correct way? I am still learning and am not a professional.
My function for generating the passwords:
function Generate(AllowUpper,AllowLower,AllowNumbers,AllowSymbols:Boolean; PassLen:Integer):String;
const
UpperList = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
LowerList = 'abcdefghijklmnopqrstuvwxyz';
NumberList = '0123456789';
SymbolList = '!#$%&/()=?#<>|{[]}\*~+#;:.-_';
var
MyList : String;
Index : Integer;
i : Integer;
begin
Result:='';
MyList:='';
//here if the flag is set the elements are added to the main array (string) to process
if AllowUpper then MyList := MyList + UpperList;
if AllowLower then MyList := MyList + LowerList;
if AllowNumbers then MyList := MyList + NumberList;
if AllowSymbols then MyList := MyList + SymbolList;
Randomize;
if Length(MyList)>0 then
for i := 1 to PassLen do
begin
Index := Random(Length(MyList))+1;
Result := Result+MyList[Index];
end;
end;
Here is how I am calling it
procedure TMain.Button3Click(Sender: TObject);
var
i: integer;
StrLst: TStringList;
// Timing vars...
Freq, StartCount, StopCount: Int64;
TimingSeconds: real;
begin
vst1.Clear;
Panel2.Caption := 'Generating Passwords...';
Application.ProcessMessages;
// Start Performance Timer...
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(StartCount);
StrLst := TStringList.Create;
try
for i := 1 to PassLenEd.Value do
StrLst.Add(Generate(ChkGrpCharSelect.Checked[0],ChkGrpCharSelect.Checked[1],
ChkGrpCharSelect.Checked[2],ChkGrpCharSelect.Checked[3],20));
// Stop Performance Timer...
QueryPerformanceCounter(StopCount);
TimingSeconds := (StopCount - StartCount) / Freq;
// Display Timing... How long it took to generate
Panel2.Caption := 'Generated '+IntToStr(PassLenEd.Value)+' passwords in '+
FloatToStrF(TimingSeconds,ffnumber,1,3)+' seconds';
// Add to VirtualTreeList - here???
finally
StrLst.Free;
end;
end;
I expect that I am doing this completely the wrong way, I have been trying for 2 days now, it would be great if someone could put me straight with how I should go about it.
Chris
I'd probably stick with TListView but turn it into a virtual list view. Like this:
procedure TMyForm.FormCreate;
begin
ListView.OwnerData := True;
ListView.OnData = ListViewData;
ListView.Items.Count := StringList.Count;
end;
procedure TMyForm.ListViewData(Sender: TObject; ListItem: TListItem);
begin
ListItem.Caption := StringList[ListItem.Index];
end;
You can put millions of items in there in an instant.
You better store your stringlist somewhere else in your code to use it "virtually", e.g. in the form's private section. When after populating it, just set:
vst1.Clear;
vst1.RootNodeCount := StrLst.Count;
And on tree's get text event:
procedure TForm1.vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
begin
CellText := StrLst[Node.Index];
end;
Or if you really want VirtualTreeView, you can use something like this ...
I'm not sure if this is absolutely clear solution, I'm familiar with records, not only one single variables.
procedure TMain.Button3Click(Sender: TObject);
var i: integer;
p: PString;
Freq, StartCount, StopCount: Int64;
TimingSeconds: real;
begin
Panel2.Caption := 'Generating Passwords...';
Application.ProcessMessages;
QueryPerformanceFrequency(Freq);
QueryPerformanceCounter(StartCount);
vst1.BeginUpdate;
vst1.Clear;
for i := 1 to PassLenEd.Value do
begin
p := VirtualStringTree1.GetNodeData(VirtualStringTree1.AddChild(nil));
p^ := Generate(ChkGrpCharSelect.Checked[0],ChkGrpCharSelect.Checked[1], ChkGrpCharSelect.Checked[2],ChkGrpCharSelect.Checked[3],20);
end;
vst1.EndUpdate;
QueryPerformanceCounter(StopCount);
TimingSeconds := (StopCount - StartCount) / Freq;
Panel2.Caption := 'Generated '+IntToStr(PassLenEd.Value)+' passwords in '+
FloatToStrF(TimingSeconds,ffnumber,1,3)+' seconds';
end;
And you need to implement OnGetNodeDataSize and OnGetText events to initialize node data size and to display the text.
procedure TMain.vst1GetNodeDataSize(
Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(string);
end;
procedure TMain.vst1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
begin
CellText := PString(VirtualStringTree1.GetNodeData(Node))^;
end;
Edit 1: I've corrected data types UnicodeString -> String