[Delphi]VirtualTreeview使用说明

VirtualTreeview使用说明

很好用的一个列表控件，可以用来代替Delphi自带的ListView和TreeView，而且也一直在更新，目前已经支持最新的XE2

官方网站：

SVN地址：/svn/trunk

基本的使用方法就不多说了，可以看看Demo，或者百度一下还是有些教程的。我这里只记录一些属性方法等，方便查阅

【属性】

EditDelay = 单元格编辑响应时间

HintAnimation = Hint动画效果

HintMode = Hint显示方式

LineMode = 网格线条模式

LineStyle = 网格线条样式

Header > AutoSizeIndex = 自适应宽度的列索引

Header > Options > hoAutoResize = 列自适应宽度开关

Header > Options > hoColumnResize = 是否可以自由调整列宽

Header > Options > hoDblClickResize = 双击分界线自动改变列度

Header > Options > hoDrag = 是否支持拖拽移动

Header > Options > hoHotTrack = 高亮显示当前列

Header > Options > hoHeightResize = 是否可以自由调整列高

TreeOptions > AutoOptions > toAutoExpand = 单击展开节点并收起其他节点

TreeOptions > AutoOptions > toAutoTristateTracking = 三态复选框自适应选择，即子节点被选择后父节点Check状态改变

TreeOptions > MiscOptions > toCheckSupport = 是否显示复选框。还需要设置节点的CheckType属性

TreeOptions > MiscOptions > toEditable = 是否允许单击编辑单元格

TreeOptions > MiscOptions > toFullRepaintOnResize = 控件大小改变时刷新显示数据

TreeOptions > MiscOptions > toToggleOnDblClick = 双击展开节点

TreeOptions > PaintOptions > toHideSelection = 隐藏选择焦点

TreeOptions > PaintOptions > toHotTrack = 当前行是否显示下划线

TreeOptions > PaintOptions > toShowDropmark = 拖拽时是否显示插入标记

TreeOptions > PaintOptions > toShowRoot = 是否显示父节点展开按钮

TreeOptions > PaintOptions > toShowHorzGridLines = 水平网格线开关

TreeOptions > PaintOptions > toShowTreeLines = 父节点与子节点的连接线

TreeOptions > PaintOptions > toShowVertGridLines = 垂直网格线开关

TreeOptions > PaintOptions > toThemeAware = 应用系统主题

TreeOptions > PaintOptions > toAlwaysHideSelection = 总是隐藏选择

TreeOptions > PaintOptions > toChildrenAbove = 父节点处于子节点下方

TreeOptions > SelectionOptions > toDisableDrawSelection = 框选开关

TreeOptions > SelectionOptions > toExtendedFocus = 是否允许Cloumn>0的单元格有焦点（有焦点的时候才能编辑）

TreeOptions > SelectionOptions > toFullRowSelect = 整行选择

TreeOptions > SelectionOptions > toMultiSelect = 是否可以多选

TreeOptions > SelectionOptions > toRightClickSelect = 右键是否可以选择

TreeOptions > SelectionOptions > toSimpleDrawSelection = 框选时只要该行处于框内即可被选择

TreeOptions > StringOptions > toShowStaticText = 是否显示静态文本（在节点正文后面显示的字符，静态文本不能编辑）

【方法】

TopNode = 设置列表顶部的节点，可以用来定位节点行

ScrollIntoView = 设置滚动条位置，可以用来定位节点行

【事件】

OnChange = 焦点改变时

OnCreateEditor = 设置某单元格的编辑框样式，比如TEdit，TComboBox等等。需要自己实现IVTEditLink接口，具体参看Advanced这个Demo

OnExpanded = 节点展开后触发

OnCollapsed = 节点收起后触发

OnPaintText = 设置单元内容字体效果，也可以画进度条等

OnHotChange = 热点节点改变时触发，也就是鼠标悬停时

单元格纵向位置及单元格高度

procedure 1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;

var InitialStates: TVirtualNodeInitStates);

begin

Node := 20; //纵向位置

ight[Node] := 20; //单元格高度

end;

动态调整列宽度

procedure 1Resize(Sender: TObject);

begin

s[1].Width := - s[1].Left - 25;

end;

单元格字体

procedure 3PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node:

PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);

var

Data: PPropertyData;

begin

// Make the root nodes underlined and draw changed nodes in bold style.

if = de then

:= [fsUnderline]

else

begin

Data := eData(Node);

if d then

:= [fsBold]

else

:= [];

end;

end;

单元格颜色

procedure 5BeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;

Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);

begin

// Fill random cells with our own background, but don't touch the currently focused cell.

if Assigned(Node) and ((Column <> dColumn) or (Node <> dNode)) and

((Column - 2) = (Integer() mod ( - 1))) then

begin

:= $E0E0E0;

ct(CellRect);

end;

end;

隐藏行

eSubtree(nil, HideNodes, Pointer(ItemIndex), [], True);

procedure des(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort:

Boolean);

begin

ble[Node] := False;

end;

单元格编辑

1. 调用Editors单元

2. 消息处理函数

const

WM_STARTEDITING = WM_USER + 2000; //消息处理函数

procedure tEditing(var Message: TMessage);

var

Node: PVirtualNode;

Sender: TBaseVirtualTree;

begin

Sender := TBaseVirtualTree();

//Node := Pointer();

Node := dNode;

if Assigned(Node) then

de(Node, );

end;

//默认对当前选中行进行编辑

//指定待编辑的列

3. 触发编辑事件

TreeOptions := [toExtendedFocus,toFullRowSelect,toRightClickSelect];

procedure 1FocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);

begin

with Sender do

begin

if Assigned(Node) and not (tsIncrementalSearching in TreeStates) then

begin

PostMessage(, WM_STARTEDITING, Integer(Sender), Column);

end;

end;

end;

4. 编辑事件控制

procedure 1Editing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;

var Allowed: Boolean);

var

Data: PPropertyData;

begin

with Sender do

begin

Data := GetNodeData(Node);

Allowed := (ypes[Column] <> vtNone);

end;

end;

5. 创建编辑框

procedure 1CreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;

out EditLink: IVTEditLink);

begin

EditLink := ;

end;

6. 内容改变

procedure 1PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode;

Column: TColumnIndex; TextType: TVSTTextType);

var

Data: PPropertyData;

begin

Data := eData(Node);

if ds[Column] then

:= [fsBold]

else

:= [];

end;

(1) 这是一个可扩展到多层的树视图。视图就是单纯显示，无法与传入数据自动同步，必须手动写。

(2) 无论父节点还是子节点，传入数据必须是一个相同的结构(record)，存放在其data属性里，通过“指针:=GetNodeData(节点)”获得地址，传入传出其“指针^.各结构属性”。

(3) 控件从RootNodeCount:=根节点数目大于0开始激发，立即激发onGetNodeDataSize，来获得传入结构数据的大小，此处可以返回sizeof(结构类型)。

(4) 然后对每个节点(包括已激发的子节点)进行OnInitNode，此处可以可以直接修改节点的属性，并用(2)的方法传入其data，以备以后调用。

(5) InitNode时，可以Include(InitialStates, ivsHasChildren)来说明含有字节点，但不会加载子节点。

如要加载，可以(1)界面直接双击打开，或者(2)代码Include(InitialStates, ivsExpanded)

亦可(3)直接调用ReinitChildren[父节点]，(4)直接设置ount[父节点]，来加载。

此时会激发onInitChildren，事件中可以设置ChildCount，然后对每一个子节点，一一激发InitNode。

(6) 每个节点激发(InitNode)后，会激发GetText，用于显示文本。此处可以根据Column来分别返回CellText。

(7) 如果某个节点Checktype设为ctCheckbox，则该节点前会增加check框，其值通过CheckState设定。

(8) 【bug】如果同为ctCheckbox，父子节点的CheckState是不关联的，也就是说，点选父节点，下属子节点一个也不会改变选值。

如需同步，就要在onCheck中用代码实现。我在本unit内，实现了

(a)父节点选中，则全部子节点也选中

(b)子节点全部选中，则父节点也选中

©子节点全部选空，则父节点也选空

即使onChecked事件即使加入了父子节点Checked同步代码，因为InitNode时不加载Child，未扩展开的子节点是无法调用onChecked代码与父节点同步的。

所以千万注意InitNode时，要用Children(Node,True);先履一遍字节点。

(9) VirtualStringTree各个事件内，许多Node参数不是“var”返回值的，所以对它们赋值于事无补。

如需要，最好使用“VirtualStringTree.各属性[节点]:=值”，具体值是否返回，可以查看VirtualStringTree源码。

(10)onGetImageIndex获得每个节点的图标，要搭配TImagelist控件；onGetHint获得每个节点的Hint。

一、【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常用方法 】

taSize := sizeOf(TMyNodeData); //设置占存储空间大小

树节点选中：ed[p_node]True; //设置节点p_node处于选中状态

树节点勾选框选中:p_tate:=cscheckedNormal;//设置节点p_node处于勾选状态

onchecked()事件：设置节点勾选时触发的事件，其中第二个参数就是勾选的节点

取消选中的节点：election;

树节点删除: SelectedNodes; //删除选中的节点

树节点内容清空：;

得到树的第一个节点:st;

得到树的第一个选中节点：stSelected;

得到节点的下一个节点:t(p_node);

得到下一个选中的节点:tSelected(p_node);

得到父节点:p_

得到子节点个数:p_ount

得到第一个子节点：p_hild

得到最后一个子节点：p_hild

得到上一个兄弟节点：p_bling

得到下一个兄弟节点：p_bling

---------------------------------------------------------------------------------------------------------------------------

三、【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 tualStringTree1;

var

p_jdtransline: pjdtransline;

begin

while not do

begin

New(p_jdtransline);

p_jdtransline^.ID := client_dataset_yName('ID').AsInteger;

p_jdtransline^.Name := Trim(client_dataset_yName('Name').AsString);

ld(nil, p_jdtransline); //*********************添加树节点***********************************

;

end;

end;

//在窗体创建时调用树的初始化事件

procedure eate(sender:Tobject);

begin

iniVirtualStringTree1;

end;

//设置各列字段的显示OnGetText() var

p_node_data : PMyNodeData;

p_jdtransline : PJDTranslineTree;

begin

p_node_data := eData(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);

ype := ctTriStateCheckBox;

end;

-------------------------------------------------VirtualStringTree树拖动操作实现开始-------------------------------------------------------------------------

五、【VirtualStringTree树节点拖动实现】

主要设置其DragOver和DragDrop事件。其中DragOver控制是否允许移动；DragDrop控制移动后执行的操作。

//一、DragOver事件

procedure lStringTree1Over(

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(eData(vn))^);

end;

//事件内部函数2.获取所有选中节点的列表

function GetSelectedVNodes(vst: TVirtualStringTree): TVNodeArray;

var

list: TList;

n: PVirtualNode;

i: Integer;

begin

list := ;

n := stSelected;

while n <> nil do

begin

(n);

n := tSelected(n);

end;

SetLength(Result, );

for i := 0 to -1 do

begin

Result[i] := list[i];

end;

;

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 = rgetNode then //移动到自己父节点不允许移动

begin

[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 := rgetNode;

TargetChildNode := hild;

TargetParentNode := ;

TargetNodeName := pjdtransline(eData(dstNode)^).name;

TargetNodeLevel := pjdtransline(eData(dstNode)^).LevelID;

for i := 0 to High(selectedList) do

begin

n := selectedList[i];

SelectNodeName := pjdtransline(eData(n)^).name;

SelectNodeLevel := pjdtransline(eData(n)^).LevelID;

if (TargetNodeLevel > SelectNodeLevel) then //目标节点级别不能比选中节点级别低

begin

[0].Text := '目标节点级别比选中节点级别低，不能移动！';

Result := True;

Break;

end;

if (TargetNodeName = SelectNodeName) then //目标节点与选中节点相同

begin

[0].Text := '目标节点值与选中节点值相同，不能移动！';

Result := True;

Break;

end;

while TargetChildNode <> nil do

begin

TargetChildNodeName := pjdtransline(eData(TargetChildNode)^).name;

if TargetChildNodeName = SelectNodeName then //目标子节点与选中节点相同

begin

[0].Text := '目标子节点存在与选中节点值相同的节点，不能移动！';

Result := True;

Break;

end;

TargetChildNode := bling;

end;

end;

end;

// //事件内部函数6.判断是否移动自己子节点或子子节点

function IsAncestor(vnDescendant, vnAncestor: PVirtualNode): Boolean;

var

p: PVirtualNode;

begin

Result := False;

p := ;

while p <> nil do

begin

if p = vnAncestor then

begin

[0].Text := '不能移动到自己的子节点或子子节点';

Result := True;

Exit;

end;

p := ;

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 := rgetNode;

srcNode := dNode;

if (srcNode = nil) or (dstNode = nil) then Exit;

if srcNode = dstNode then

begin

[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

[0].Text := '可以移动'

else

Break;

end;

end;

dmNowhere:

Accept := False;

else

end;

end;

二、DragDrop事件

procedure lStringTree1DragDrop(

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 := ;

n := stSelected;

while n <> nil do

begin

(n);

n := tSelected(n);

end;

SetLength(Result, );

for i := 0 to -1 do

begin

Result[i] := list[i];

end;

;

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 := rgetNode;

TargetNodeID := PPurview(eData(dstNode)^).ID;

selectedList := GetSelectedVNodes(VirtualStringTree1);

srcNode := dNode;

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];

(srcNode, dstNode, amAddChildFirst, False);

SelectNodeID := PPurview(eData(srcNode)^).ID;

SelectNodeFID := PPurview(eData(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;

(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 veVehiclePaintText(Sender: TBaseVirtualTree;

const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;

TextType: TVSTTextType);

begin

p_node_data := tActiveVehicleNodeData(vtActiveVehicle, Node); //获取节点data

if not Assigned(p_node_data) then

Exit;

vInfo := PGPSClientVehicleInfoColumn(s[Column].Data);

if vInfo <> nil then

begin

if (Pos('盲区',p_node_data^.te)>0) and //判断节点值满足某条件

(vInfo^.ame = 'GPS_Speed') then //判断是哪个列，如果是整个节点都变颜色可不需此条件

:= clMedGray; //速度列变灰色

if (Pos('盲区',p_node_data^.te)>0) and

(vInfo^.ame = 'GPS_Precision') then

:= clred; //精度列变红色

if (SecondsBetween(Now(), p_node_data^.e)>=7200) and //盲区条件

(vInfo^.ame = 'GPS_Speed') then //速度列

:= clMedGray;

if (SecondsBetween(Now(), p_node_data^.e)>=7200) and

(vInfo^.ame = 'GPS_RealStatus') then

:= clred;

end;