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

unit virtree;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, VirtualTrees, ImgList, cxGraphics, Menus, VTHeaderPopup;

type
  TForm1 = class(TForm)
    vrtlstrngtr1: TVirtualStringTree;
    btn1: TButton;
    cxmglst1: TcxImageList;
    vthdrpmn1: TVTHeaderPopupMenu;
    N1: TMenuItem;
    pm1: TPopupMenu;
    N2: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure vrtlstrngtr1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure vrtlstrngtr1GetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure vrtlstrngtr1FreeNode(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure vrtlstrngtr1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: string);
    procedure vrtlstrngtr1Editing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure vrtlstrngtr1GetPopupMenu(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
      var AskParent: Boolean; var PopupMenu: TPopupMenu);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  PMyRec = ^TMyRec;
  TMyRec = record            //记录自己的节点结构类型
    Caption,
    SubCaption: String;
    ImageIndex: Integer;
    Msize:Integer;
  end;

//Description: 添加节点
procedure TForm1.btn1Click(Sender: TObject);
var
  RootNode,ChildNode:PVirtualNode;
  Data:PMyRec;
begin
  //添加根节点
  RootNode:=vrtlstrngtr1.AddChild(nil);
  Data:=vrtlstrngtr1.GetNodeData(RootNode);
  with Data^ do
  begin
    Caption:='';//显示图标';
    SubCaption:='dd';
    Msize:=20;
    ImageIndex:=0;
  end;
  //------------添加子节点-------------

  ChildNode := vrtlstrngtr1.AddChild(RootNode);
  Data := vrtlstrngtr1.GetNodeData(ChildNode);
  with Data^ do
  begin
    Caption := '第二行，第一列';
    SubCaption := '第二行，第二列';
    ImageIndex := 1;
  end;

  //------------添加子节点-------------
  ChildNode := vrtlstrngtr1.AddChild(RootNode);
  Data := vrtlstrngtr1.GetNodeData(ChildNode);
  with Data^ do
  begin
    Caption := '第三行，第一列';
    SubCaption := '第三行，第二列';
    ImageIndex := 1;
  end;
  vrtlstrngtr1.Expanded[RootNode] := True;       //展开根节点

end;

//Description: 窗体创建函数
procedure TForm1.FormCreate(Sender: TObject);
begin
  with vrtlstrngtr1 do
  begin
    NodeDataSize:=SizeOf(TMyRec); //设置节点数据空间
    RootNodeCount:=0;             //设置初始化节点数
    Images:= cxmglst1;            //图片关联

    //添加列头，也可以双击控件添加
    with Header.Columns.Add do
    begin
      Text:='图标';
      Width:=200;
      Options:=Options-[coDraggable];  //不允许列头拖动
    end;

    with Header.Columns.Add do
    begin
      Text := '邮件';
      Width := 220;
    end;

    with Header.Columns.Add do
    begin
      Text := '邮件大小';
      Width := 220;
    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;

procedure TForm1.FormShow(Sender: TObject);
begin
end;

//Description: 右键菜单显示节点信息

procedure TForm1.N1Click(Sender: TObject);
var
  Data: PMyRec;
begin
  Data := vrtlstrngtr1.GetNodeData(vrtlstrngtr1.FocusedNode);
  if Assigned(Data) then
    ShowMessage('当前节点：' + Data.Caption);

end;

//Description: 具体控制某列是否可以出现编辑框

procedure TForm1.vrtlstrngtr1Editing(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.vrtlstrngtr1FreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  Data: PMyRec;
begin
  Data := Sender.GetNodeData(Node);
  Finalize(Data^);

end;

//Description: 节点的图片索引

procedure TForm1.vrtlstrngtr1GetImageIndex(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.vrtlstrngtr1GetPopupMenu(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 := pm1;  //让第一列管理菜单
      1: PopupMenu := nil;    //让第二列无菜单
    end;
end;

//Description: 树节点显示的字符串数据
procedure TForm1.vrtlstrngtr1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
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
      2: CellText := IntToStr(Data.Msize)+'MB'; //用来显示邮件的大小
    end;

end;

procedure TForm1.vrtlstrngtr1NewText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; NewText: string);
var
  Data: PMyRec;
begin
  Data := Sender.GetNodeData(Node);
  case Column of
    0: Data.Caption := NewText;
    1: Data.SubCaption := NewText;     //将编辑框的值赋到节点上
  end;

end;

end.