Delphi 7下使用VT实现树型列表结合控件

时间:2022-10-22 11:52:28

   在Delphi 7下有TTreeView和TListView控件,有时候我们需要这两个控件相结合的功能,除了自己组合成这样的复合控件,还可以使用VT(Virtual TreeView)来实现。在前篇介绍了《Virtual Treeview 5.0.0的安装以及入门》后,我们继续学习进一步的应用。

1.新建Delphi应用程序,在窗体上放置TVirtualStringTree、TImageList、TXPManifest、TPopupMenu,右键ImageList添加两个16x16的图标,右键PopupMenu添加一个菜单项“节点信息”;

Delphi 7下使用VT实现树型列表结合控件Delphi 7下使用VT实现树型列表结合控件
2.单元文件代码如下:

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
{------------------------------------------------------------------------------- 
 在Delphi 7下Virtual Treeview的简单使用(二)    http://blog.csdn.net/akof1314 
-------------------------------------------------------------------------------} 
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, VirtualTrees, StdCtrls, XPMan, ImgList, Menus; 
 
type 
  TForm1 = class(TForm) 
    vrtlstrngtrVST: TVirtualStringTree; 
    btnAddRoot: TButton; 
    xpmnfst1: TXPManifest; 
    ilVST: TImageList; 
    pmVST: TPopupMenu; 
    mniN1: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure btnAddRootClick(Sender: TObject); 
    procedure vrtlstrngtrVSTGetText(Sender: TBaseVirtualTree; 
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; 
      var CellText: WideString); 
    procedure vrtlstrngtrVSTFreeNode(Sender: TBaseVirtualTree; 
      Node: PVirtualNode); 
    procedure vrtlstrngtrVSTGetImageIndex(Sender: TBaseVirtualTree; 
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; 
      var Ghosted: Boolean; var ImageIndex: Integer); 
    procedure vrtlstrngtrVSTNewText(Sender: TBaseVirtualTree; 
      Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); 
    procedure vrtlstrngtrVSTEditing(Sender: TBaseVirtualTree; 
      Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); 
    procedure vrtlstrngtrVSTGetPopupMenu(Sender: TBaseVirtualTree; 
      Node: PVirtualNode; Column: TColumnIndex; const P: TPoint; 
      var AskParent: Boolean; var PopupMenu: TPopupMenu); 
    procedure mniN1Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
{------------------------------------------------------------------------------- 
 Description: 定义一个记录类型,根据所需添加内容 
-------------------------------------------------------------------------------} 
type 
  PMyRec = ^TMyRec; 
  TMyRec = record            //记录自己的节点结构类型 
    Caption, 
    SubCaption: String
    ImageIndex: Integer; 
  end
{------------------------------------------------------------------------------- 
 Description: 窗体创建函数 
-------------------------------------------------------------------------------} 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with vrtlstrngtrVST do 
  begin 
    NodeDataSize := SizeOf(TMyRec);   //设置节点数据空间 
    RootNodeCount := 0;               //设置初始化节点数 
    Images := ilVST;                  //图片关联 
 
    //---------------------开始:添加列头(也可以双击控件添加)----------------- 
    with Header.Columns.Add do 
    begin 
      Text := '列一'
      Width := 150
      Options := Options - [coDraggable];          //不允许列头拖动 
    end
 
    with Header.Columns.Add do 
    begin 
      Text := '列二'
      Width := 120
    end
    //-----------------------结束:添加列头------------------------------------- 
    Header.Options := Header.Options + [hoVisible] + [hoHotTrack];  //可见列头,滑过热点 
    Header.Height := 23
 
    TreeOptions.SelectionOptions := TreeOptions.SelectionOptions 
                                  + [toExtendedFocus]        //让非主列也可以点击 
                                  + [toMultiSelect]          //支持多选 
                                  + [toRightClickSelect];    //右键选择 
                                { + [toFullRowSelect];       //整行选中} 
 
    TreeOptions.MiscOptions := TreeOptions.MiscOptions 
                             + [toEditable];  //让节点可编辑,在Editing更能分列控制是否可编辑 
    EditDelay := 50;  //两次单击间隔多久才出现编辑框 
  end
end
{------------------------------------------------------------------------------- 
 Description: 添加节点 
-------------------------------------------------------------------------------} 
procedure TForm1.btnAddRootClick(Sender: TObject); 
var 
  RootNode,ChildNode: PVirtualNode; 
  Data: PMyRec; 
begin            
  //------------添加根节点----------- 
  RootNode := vrtlstrngtrVST.AddChild(nil); 
  Data := vrtlstrngtrVST.GetNodeData(RootNode); 
  with Data^ do 
  begin 
    Caption := '第一行,第一列'
    SubCaption := '第一行,第二列'
    ImageIndex := 0
  end
 
  //------------添加子节点------------- 
  ChildNode := vrtlstrngtrVST.AddChild(RootNode); 
  Data := vrtlstrngtrVST.GetNodeData(ChildNode); 
  with Data^ do 
  begin 
    Caption := '第二行,第一列'
    SubCaption := '第二行,第二列'
    ImageIndex := 1
  end
 
  //------------添加子节点------------- 
  ChildNode := vrtlstrngtrVST.AddChild(RootNode); 
  Data := vrtlstrngtrVST.GetNodeData(ChildNode); 
  with Data^ do 
  begin 
    Caption := '第三行,第一列'
    SubCaption := '第三行,第二列'
    ImageIndex := 1
  end
  vrtlstrngtrVST.Expanded[RootNode] := True;       //展开根节点 
end
{------------------------------------------------------------------------------- 
 Description: 树节点显示的字符串数据 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTGetText(Sender: TBaseVirtualTree; 
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; 
  var CellText: WideString); 
var 
  Data: PMyRec; 
begin 
  Data := Sender.GetNodeData(Node); 
  if Assigned(Data) then 
    case Column of 
      0: CellText := Data.Caption;       //列一显示结构体的Caption 
      1: CellText := Data.SubCaption;    //列二显示结构体的SubCaption 
    end
end
{------------------------------------------------------------------------------- 
 Description: 节点的图片索引 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTGetImageIndex(Sender: TBaseVirtualTree; 
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; 
  var Ghosted: Boolean; var ImageIndex: Integer); 
var 
  Data: PMyRec; 
begin 
  Data := Sender.GetNodeData(Node); 
  if Column = 0 then 
    ImageIndex := Data.ImageIndex;      //列一绑定图片索引 
end
{------------------------------------------------------------------------------- 
 Description: 释放节点数据 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTFreeNode(Sender: TBaseVirtualTree; 
  Node: PVirtualNode); 
var 
  Data: PMyRec; 
begin 
  Data := Sender.GetNodeData(Node); 
  Finalize(Data^); 
end
{------------------------------------------------------------------------------- 
 Description: 编辑框更新内容到节点 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTNewText(Sender: TBaseVirtualTree; 
  Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); 
var 
  Data: PMyRec; 
begin 
  Data := Sender.GetNodeData(Node); 
  case Column of 
    0: Data.Caption := NewText; 
    1: Data.SubCaption := NewText;     //将编辑框的值赋到节点上 
  end;     
end
{------------------------------------------------------------------------------- 
 Description: 具体控制某列是否可以出现编辑框 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTEditing(Sender: TBaseVirtualTree; 
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); 
begin 
  case Column of 
    0: Allowed := False; //不让第一列可编辑 
    1: Allowed := True;  //第二列可编辑,并且在编辑过程中,按TAB键会跳到下一同列节点进入编辑模式 
  end;     
end
{------------------------------------------------------------------------------- 
 Description: 具体控制某列是否可以出现右键菜单 
-------------------------------------------------------------------------------} 
procedure TForm1.vrtlstrngtrVSTGetPopupMenu(Sender: TBaseVirtualTree; 
  Node: PVirtualNode; Column: TColumnIndex; const P: TPoint; 
  var AskParent: Boolean; var PopupMenu: TPopupMenu); 
begin 
  if Assigned(Node) then 
    case Column of 
      0: PopupMenu := pmVST;  //让第一列管理菜单 
      1: PopupMenu := nil;    //让第二列无菜单 
    end;     
end
{------------------------------------------------------------------------------- 
 Description: 右键菜单显示节点信息 
-------------------------------------------------------------------------------} 
procedure TForm1.mniN1Click(Sender: TObject); 
var 
  Data: PMyRec; 
begin 
  Data := vrtlstrngtrVST.GetNodeData(vrtlstrngtrVST.FocusedNode); 
  if Assigned(Data) then 
    ShowMessage('当前节点:' + Data.Caption); 
end
 
end

3.运行结果如下图所示:

Delphi 7下使用VT实现树型列表结合控件