例子：创建了一个树名为VirtualStringTree1，第一列显示数据库字段ID的值，标题为编号；第二列显示字段Name的值，标题为名字。
一、【TVirtualStringTree常用属性】
BorderStyle :设置边框选项 bsSingle设置单边框
为TVirtualStringTree添加列及列标题：
Header--Columns : 设置列 点击“…”，在弹出界面点击add new按钮，就增加一列，在其text中输入列名,在width输入列宽度；
Header--options-hovisible: 设置列可显示！！
Header-Style :设置树的主题类型
ScrollBaroptions--AlwaysVisible 滚动条是否总是可见
ScrollBarOptions-ScrollBars-ssVertical 设置为只有竖向滚动条
为TVirtualStringTree添加勾选框、选择框、复选框：
TreeOptions----MiscOpitions---toCheckSupport 设置为True即可
CheckImageKind 为勾选框设置图标
Header-Maincolumn 设置勾选框在第几列前面，默认为0也就是在第一列前面
并设置ongettext()事件和onInitailNode()事件，见下面事件部分。
--------------------------------------------------------------------------------------------------------------------------------------------
二、 【TVirtualStringTree常用方法 】
VirtualStringTree1.NodeDataSize := sizeOf(TMyNodeData); //设置占存储空间大小
树节点选中：VirtualStringTree1.Selected[p_node]True; //设置节点p_node处于选中状态
树节点勾选框选中:p_node.CheckState:=cscheckedNormal;//设置节点p_node处于勾选状态
onchecked()事件：设置节点勾选时触发的事件，其中第二个参数就是勾选的节点
取消选中的节点：VirtualStringTree1.ClearSelection;
树节点删除: VirtualStringTree1.DeleteSelectedNodes; //删除选中的节点
树节点内容清空：VirtualStringTree1.clear;
得到树的第一个节点:VirtualStringTree1.GetFirst;
得到树的第一个选中节点：VirtualStringTree1.GetFirstSelected;
得到节点的下一个节点:VirtualStringTree1.Getnext(p_node);
得到下一个选中的节点:VirtualStringTree1.GetNextSelected(p_node);
得到父节点:p_node.Parent
得到子节点个数:p_node.ChildCount
得到第一个子节点：p_node.FirstChild
得到最后一个子节点：p_node.FirstChild
得到上一个兄弟节点：p_node.PrevSibling
得到下一个兄弟节点：p_node.NextSibling
---------------------------------------------------------------------------------------------------------------------------
三、【TVirtualStringTree显示数据库字段内容】：
//定义一个指针
type
Tjdtransline =record
id: integer; //编号
name : string; //名称
levelID : integer;//级别，例如总公司levelID 为0、二级公司为1、三级公司levelID 为2等
FatherID:integer; //节点的父节点ID
end;
pjdtransline =^Tjdtransline ;
private
procedure iniVirtualStringTree1; //事件声明为全局私有事件
//树显示数据库字段内容
procedure form1.iniVirtualStringTree1;
var
p_jdtransline: pjdtransline;
begin
while not adoquery1.Eof do
begin
New(p_jdtransline);
p_jdtransline^.ID := client_dataset_jdtransline.FieldByName('ID').AsInteger;
p_jdtransline^.Name := Trim(client_dataset_jdtransline.FieldByName('Name').AsString);
VirtualStringTree1.AddChild(nil, p_jdtransline); //*********************添加树节点***********************************
adoquery1.Next;
end;
end;
//在窗体创建时调用树的初始化事件
procedure form1.formcreate(sender:Tobject);
begin
iniVirtualStringTree1;
end;
//设置各列字段的显示OnGetText() var
p_node_data : PMyNodeData;
p_jdtransline : PJDTranslineTree;
begin
p_node_data := VirtualStringTree1.GetNodeData(Node);
p_jdtransline := p_node_data^.my_data_ptr;
case Column of
0 : CellText := inttostr( p_jdtransline^.ID);
1: CellText := p_jdtransline^.Name;
end;
end;
------------------------------------------------------------------------------------------------------------------------------------
四、 【TVirtualStringTree设置节点展开与折叠的图标 】
OnInitNode() //设置结点的节点是否有子节点类型（‘+’、‘—’显示）
begin
Include(InitialStates, ivsHasChildren);
Node.CheckType := ctTriStateCheckBox;
end;
-------------------------------------------------VirtualStringTree树拖动操作实现开始-------------------------------------------------------------------------
五、【VirtualStringTree树节点拖动实现】
主要设置其DragOver和DragDrop事件。其中DragOver控制是否允许移动；DragDrop控制移动后执行的操作。
//一、DragOver事件
procedure form1.VirtualStringTree1Over(
Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState;
State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer;
var Accept: Boolean);
//事件内部函数1.获取节点的值
function GetVNodeData(vn: PVirtualNode; vst: TVirtualStringTree): PVNodeData;
begin
Result := PVNodeData(PPointer(vst.GetNodeData(vn))^);
end;
//事件内部函数2.获取所有选中节点的列表
function GetSelectedVNodes(vst: TVirtualStringTree): TVNodeArray;
var
list: TList;
n: PVirtualNode;
i: Integer;
begin
list := TList.Create;
n := vst.GetFirstSelected;
while n <> nil do
begin
list.Add(n);
n := vst.GetNextSelected(n);
end;
SetLength(Result, list.Count);
for i := 0 to list.Count-1 do
begin
Result[i] := list[i];
end;
list.Free;
end;
// //事件内部函数3.判断是否是移动到自己的父节点
function IsSameLevel(selectedList: TVNodeArray): Boolean;
var
n: PVirtualNode;
l: Cardinal;
i: Integer;
begin
Result := False;
if Length(selectedList) = 0 then
begin
Result := True;
Exit;
end;
for i := 0 to High(selectedList) do
begin
n := selectedList[i];
if n.Parent = Sender.DropTargetNode then //移动到自己父节点不允许移动
begin
HintBar.Panels[0].Text := '不允许移动到自己的父节点';
Result := True;
Break;
end;
end;
end;
// //事件内部函数4.判断目标(父、子）节点中是否与选中节点名称相同
function IsExistSelectObject(selectedList: TVNodeArray): Boolean;
var
dstNode : PVirtualNode;
n : PVirtualNode;
i : Integer;
TargetChildNode : PVirtualNode;
TargetParentNode : PVirtualNode;
SelectNodeName : String;
TargetNodeName : String;
TargetChildNodeName : String;
TargetParentNodeName: String;
SelectNodeLevel : Integer;
TargetNodeLevel : Integer;
begin
Result := False;
if Length(selectedList) = 0 then
begin
Exit;
end;
dstNode := Sender.DropTargetNode;
TargetChildNode := dstNode.FirstChild;
TargetParentNode := dstNode.Parent;
TargetNodeName := pjdtransline(VtPurview.GetNodeData(dstNode)^).name;
TargetNodeLevel := pjdtransline(VtPurview.GetNodeData(dstNode)^).LevelID;
for i := 0 to High(selectedList) do
begin
n := selectedList[i];
SelectNodeName := pjdtransline(VtPurview.GetNodeData(n)^).name;
SelectNodeLevel := pjdtransline(VtPurview.GetNodeData(n)^).LevelID;
if (TargetNodeLevel > SelectNodeLevel) then //目标节点级别不能比选中节点级别低
begin
HintBar.Panels[0].Text := '目标节点级别比选中节点级别低，不能移动！';
Result := True;
Break;
end;
if (TargetNodeName = SelectNodeName) then //目标节点与选中节点相同
begin
HintBar.Panels[0].Text := '目标节点值与选中节点值相同，不能移动！';
Result := True;
Break;
end;
while TargetChildNode <> nil do
begin
TargetChildNodeName := pjdtransline(VtPurview.GetNodeData(TargetChildNode)^).name;
if TargetChildNodeName = SelectNodeName then //目标子节点与选中节点相同
begin
HintBar.Panels[0].Text := '目标子节点存在与选中节点值相同的节点，不能移动！';
Result := True;
Break;
end;
TargetChildNode := TargetChildNode.NextSibling;
end;
end;
end;
// //事件内部函数6.判断是否移动自己子节点或子子节点
function IsAncestor(vnDescendant, vnAncestor: PVirtualNode): Boolean;
var
p: PVirtualNode;
begin
Result := False;
p := vnDescendant.Parent;
while p <> nil do
begin
if p = vnAncestor then
begin
HintBar.Panels[0].Text := '不能移动到自己的子节点或子子节点';
Result := True;
Exit;
end;
p := p.Parent;
end;
end;
//事件定义变量
var
Node : TTreeNode;
VirtualStringTree1: TVirtualStringTree;
dstNode, srcNode: PVirtualNode;
srcText, dstText, s: string;
selectedList: TVNodeArray;
i: Integer;
begin
Accept := False;
if not (Source is TVirtualStringTree) then Exit;
VirtualStringTree1 := TVirtualStringTree(Source);
dstNode := Sender.DropTargetNode;
srcNode := VirtualStringTree1.FocusedNode;
if (srcNode = nil) or (dstNode = nil) then Exit;
if srcNode = dstNode then
begin
HintBar.Panels[0].Text := '目标节点必须与选中节点不同！';
Exit;
end;
selectedList := GetSelectedVNodes(VirtualStringTree1);
if IsSameLevel(selectedList) then
begin
Accept := False;
Exit;
end;
if IsExistSelectObject(selectedList) then
begin
Accept := False;
Exit;
end;
// dstText := GetVNodeData(dstNode, VirtualStringTree1).Name;
case Mode of
dmAbove: // 成为父节点;
begin
Accept := False;
end;
dmBelow: // 成为子节点，本例主要采用成为子节点模式
begin
for i := 0 to High(selectedList) do
begin
srcNode := selectedList[i];
Accept := not IsAncestor(dstNode, srcNode);
if not Accept then Break;
end;
end;
dmOnNode: // 成为同级节点
begin
for i := 0 to High(selectedList) do
begin
srcNode := selectedList[i];
Accept := not IsAncestor(dstNode, srcNode);
if Accept then
HintBar.Panels[0].Text := '可以移动'
else
Break;
end;
end;
dmNowhere:
Accept := False;
else
end;
end;
二、DragDrop事件
procedure Tform1.VirtualStringTree1DragDrop(
Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
Formats: TFormatArray; Shift: TShiftState; Pt: TPoint;
var Effect: Integer; Mode: TDropMode);
//事件内部函数--获取选中节点的list
function GetSelectedVNodes(VtPurview: TVirtualStringTree): TVNodeArray;
var
list: TList;
n: PVirtualNode;
i: Integer;
begin
list := TList.Create;
n := VtPurview.GetFirstSelected;
while n <> nil do
begin
list.Add(n);
n := VtPurview.GetNextSelected(n);
end;
SetLength(Result, list.Count);
for i := 0 to list.Count-1 do
begin
Result[i] := list[i];
end;
list.Free;
end;
var
VirtualStringTree1: TVirtualStringTree;
dstNode, srcNode: PVirtualNode;
selectedList: TVNodeArray;
i: Integer;
TargetNodeID : integer;
SelectNodeID : integer;
SelectNodeFID: integer;
sql_str : string;
begin
VirtualStringTree1 := TVirtualStringTree(Source);
dstNode := Sender.DropTargetNode;
TargetNodeID := PPurview(VtPurview.GetNodeData(dstNode)^).ID;
selectedList := GetSelectedVNodes(VirtualStringTree1);
srcNode := VirtualStringTree1.FocusedNode;
if (srcNode = nil) or (dstNode = nil) then Exit;
case Mode of
dmAbove: // 成为父节点;
begin
end;
dmBelow: // 成为子节点
begin
if IDYES = MessageBox(Handle, PChar('是否将操作保存到数据库？'), '确认保存',MB_ICONQUESTION or MB_YESNO or MB_DEFBUTTON2) then
begin
for i := 0 to High(selectedList) do
begin
srcNode := selectedList[i];
VirtualStringTree1.MoveTo(srcNode, dstNode, amAddChildFirst, False);
SelectNodeID := PPurview(VtPurview.GetNodeData(srcNode)^).ID;
SelectNodeFID := PPurview(VtPurview.GetNodeData(srcNode)^).FatherID;
//执行数据库操作
if sql_str = '' then
sql_str := Format('exec p_VehicleGroupTreeDragMove %d,%d,%d ',
[SelectNodeID,
SelectNodeFID,
TargetNodeID
])
else
sql_str := sql_str + Format(';exec p_VehicleGroupTreeDragMove %d,%d,%d ',
[SelectNodeID,
SelectNodeFID,
TargetNodeID
]);
end;
VirtualStringTree1.Sort(dstNode, 0, sdAscending, False);
end
else
exit;
end;
dmOnNode: // 成为同级节点
begin
end;
dmNowhere:
begin
end;
else
end;
if sql_str<>'' then
begin
ExcuteSQL(sql_str); //保存拖动后节点的上下级关系
end;
end;
-------------------------------------------------VirtualStringTree树拖动操作实现结束-------------------------------------------------------------------------
六、实现VirtualStringTree（TVirtualStringTree）树节点字体颜色分多颜色显示 oncellpaint()事件
客户要求盲区或掉线的字体要显示红色，速度值要显示灰色
代码如下：
procedure TfrmMain.vtActiveVehiclePaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType);
begin
p_node_data := TGPSClientVTVUtils.ExtractActiveVehicleNodeData(vtActiveVehicle, Node); //获取节点data
if not Assigned(p_node_data) then
Exit;
vInfo := PGPSClientVehicleInfoColumn(vtActiveVehicle.Header.Columns[Column].Data);
if vInfo <> nil then
begin
if (Pos('盲区',p_node_data^.CarInfo.GpsInfo.GpsState)>0) and //判断节点值满足某条件
(vInfo^.FieldInfo.FieldName = 'GPS_Speed') then //判断是哪个列，如果是整个节点都变颜色可不需此条件
TargetCanvas.Font.Color := clMedGray; //速度列变灰色
if (Pos('盲区',p_node_data^.CarInfo.GpsInfo.GpsState)>0) and
(vInfo^.FieldInfo.FieldName = 'GPS_Precision') then
TargetCanvas.Font.Color := clred; //精度列变红色
if (SecondsBetween(Now(), p_node_data^.CarInfo.GpsInfo.GPSTime)>=7200) and //盲区条件
(vInfo^.FieldInfo.FieldName = 'GPS_Speed') then //速度列
TargetCanvas.Font.Color := clMedGray;
if (SecondsBetween(Now(), p_node_data^.CarInfo.GpsInfo.GPSTime)>=7200) and
(vInfo^.FieldInfo.FieldName = 'GPS_RealStatus') then
TargetCanvas.Font.Color := clred;
end;
