
最强开源Delphi树形控件VirtualTreeView示例
发布日期:2021-05-04 20:44:03
浏览次数:18
分类:精选文章
本文共 6491 字,大约阅读时间需要 21 分钟。
十多年的发展创造了当今最灵活,最先进的Delphi树视图控件!VirtualTreeview不会读取其管理的数据,除了其大小,甚至节点的标题也是如此。一切都是通过事件或后代(通过重写方法)从应用程序中检索的。Virtual Treeview已经证明了其概念以及在许多商业产品和免费软件项目中的出色可用性。欢迎加入Delphi开发局QQ群:32422310
unit Main;// Demonstration project for TVirtualStringTree to generally show how to get started.// Written by Mike Lischke.interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, VirtualTrees, StdCtrls, ExtCtrls;type TMainForm = class(TForm) VST: TVirtualStringTree; ClearButton: TButton; AddOneButton: TButton; Edit1: TEdit; Button1: TButton; Label1: TLabel; CloseButton: TButton; procedure FormCreate(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure AddButtonClick(Sender: TObject); procedure VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure CloseButtonClick(Sender: TObject); procedure VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure VSTAddToSelection(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure VSTAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure VSTAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect); procedure VSTChecked(Sender: TBaseVirtualTree; Node: PVirtualNode); end;var MainForm: TMainForm;//----------------------------------------------------------------------------------------------------------------------implementation{$R *.DFM}type // This is a very simple record we use to store data in the nodes. // 这是一个非常简单的记录类型我们用来在节点中储存数据 // Since the application is responsible to manage all data including the node's caption //因为应用程序负责管理包括节点标题在内的所有数据 // this record can be considered as minimal requirement in all VT applications. //该记录可被视为所有VT应用的最低要求。 // Extend it to whatever your application needs. //根据你的应用需求扩展这个示例 PMyRec = ^TMyRec;//记录指针 TMyRec = record Caption: WideString; //标题 end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.FormCreate(Sender: TObject);begin // Let the tree know how much data space we need. //让树形控件知道我们需要多少数据空间。 VST.NodeDataSize := SizeOf(TMyRec); // Set an initial number of nodes.设置一个节点初始数值 VST.RootNodeCount := 20;end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.ClearButtonClick(Sender: TObject);var Start: Cardinal;begin Screen.Cursor := crHourGlass; try Start := GetTickCount; VST.Clear; Label1.Caption := Format('Last operation duration: %d ms', [GetTickCount - Start]); finally Screen.Cursor := crDefault; end;end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.AddButtonClick(Sender: TObject);var Count: Cardinal; Start: Cardinal;begin // Add some nodes to the treeview. 添加节点 Screen.Cursor := crHourGlass; with VST do try Start := GetTickCount; case (Sender as TButton).Tag of 0: // add to root 添加到根节点 begin Count := StrToInt(Edit1.Text); //数量 RootNodeCount := RootNodeCount + Count; //根节点数量 end; 1: // add as child 添加子节点 if Assigned(FocusedNode) then begin Count := StrToInt(Edit1.Text); //数量 ChildCount[FocusedNode] := ChildCount[FocusedNode] + Count;//子节点数量 Expanded[FocusedNode] := True; //展开节点 InvalidateToBottom(FocusedNode); end; end; Label1.Caption := Format('Last operation duration: %d ms', [GetTickCount - Start]); finally Screen.Cursor := crDefault; end;end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);var Data: PMyRec;begin // A handler for the OnGetText event is always needed as it provides the tree with the string data to display. //始终需要OnGetText事件的处理程序,因为它向树形控件提供要显示的字符串数据。 Data := Sender.GetNodeData(Node); //获取节点数据 if Assigned(Data) then CellText := Data.Caption; //显示节点数据end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.VSTAddToSelection(Sender: TBaseVirtualTree; Node: PVirtualNode);begin // VST.Colors.SelectionTextColor:=clred;end;procedure TMainForm.VSTAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);begin VST.Colors.SelectionTextColor:=clred; //选择节点显示红色end;procedure TMainForm.VSTAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas);begin VST.Colors.SelectionTextColor:=clred; //选择节点显示红色end;procedure TMainForm.VSTChecked(Sender: TBaseVirtualTree; Node: PVirtualNode);begin VST.Colors.SelectionTextColor:=clred; //选择节点显示红色end;procedure TMainForm.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);var Data: PMyRec;begin Data := Sender.GetNodeData(Node); // Explicitely free the string, the VCL cannot know that there is one but needs to free // it nonetheless. For more fields in such a record which must be freed use Finalize(Data^) instead touching // every member individually.//明确地释放字符串,VCL无法知道有一个,但需要释放//尽管如此。对于此类记录中必须释放的更多字段,请使用Finalize(Data^)代替touch//每个成员都是单独的。 Finalize(Data^);end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);var Data: PMyRec;begin with Sender do begin Data := GetNodeData(Node); // Construct a node caption. This event is triggered once for each node but // appears asynchronously, which means when the node is displayed not when it is added.//构造节点标题。每个节点触发一次此事件,但是//异步显示,这意味着当节点显示时,而不是在添加节点时。 Data.Caption := Format('Level %d, Index %d', [GetNodeLevel(Node), Node.Index]); end;end;//----------------------------------------------------------------------------------------------------------------------procedure TMainForm.CloseButtonClick(Sender: TObject);begin Close;end;end.
发表评论
最新留言
网站不错 人气很旺了 加油
[***.192.178.218]2025年04月02日 07时53分11秒
关于作者

喝酒易醉,品茶养心,人生如梦,品茶悟道,何以解忧?唯有杜康!
-- 愿君每日到此一游!
推荐文章
网站故障公告1:使用阿里云RDS之后一个让人欲哭无泪的下午
2021-05-09
上周热点回顾(6.3-6.9)
2021-05-09
上周热点回顾(8.12-8.18)
2021-05-09
【故障公告】升级阿里云 RDS SQL Server 实例故障经过
2021-05-09
蹒跚来迟:新版博客后台上线公测
2021-05-09
上周热点回顾(9.16-9.22)
2021-05-09
上周热点回顾(11.4-11.10)
2021-05-09
[网站公告]11月26日00:00-04:00阿里云RDS升级
2021-05-09
[网站公告]又拍云API故障造成图片无法上传(已恢复)
2021-05-09
上周热点回顾(12.16-12.22)
2021-05-09
云计算之路-阿里云上:“黑色30秒”走了,“黑色1秒”来了,真相也许大白了
2021-05-09
云计算之路-阿里云上:奇怪的CPU 100%问题
2021-05-09
云计算之路-阿里云上:2014年6月12日12点IIS请求到达量突降
2021-05-09
上周热点回顾(6.9-6.15)
2021-05-09
上周热点回顾(6.16-6.22)
2021-05-09
上周热点回顾(10.20-10.26)
2021-05-09
上周热点回顾(2.16-2.22)
2021-05-09
上周热点回顾(3.2-3.8)
2021-05-09
.NET跨平台之旅:借助ASP.NET 5 Beta5的新特性显示CLR与操作系统信息
2021-05-09
上周热点回顾(7.27-8.2)
2021-05-09