Delphi下Virtual-TreeView（树型控件）使用详解

NolanDing

已于 2024-12-19 15:01:41 修改

阅读量722

点赞数 4

CC 4.0 BY-SA版权

分类专栏： Delphi 名库讲解文章标签：控件 Delphi VirtualTree

于 2024-12-10 11:19:59 首次发布

本文链接：https://blog.csdn.net/gust2013/article/details/144369067

Delphi 名库讲解专栏收录该内容

4 篇文章

订阅专栏

1. 前言

在 Delphi 中，虽然提供了 TreeView 和 ListView 控件，但它们的功能相对单一，往往无法满足一些特定的个性化需求。幸运的是，借助 Virtual Treeview 控件，我们可以轻松实现各种创新的功能。由于该控件的文档资源相对较少，学习曲线可能较为陡峭。因此，本篇文章将全面讲解 Virtual Treeview 控件的使用，希望能帮助大家快速掌握这个控件的使用，并在实际项目中发挥它的强大优势。

2. 效果演示

请添加图片描述

3. 源码下载

Virtual Treeview控件源码：https://download.csdn.net/download/gust2013/90091385
全部示例Demo源码：https://download.csdn.net/download/gust2013/90155642

4. 控件安装

把源代码中的Source目录添加到IDE的库路径中，32与64平台都添加
双击打开VirtualTreesDevelopment.groupproj
编译VirtualTreesRxxx.bpl
编译、安装VirtualTreesDxxx.bpl

5. 类似TreeView的树形控件

5.1 定义数据结构

使用Virtual Treeview的第一步就是要定义数据结构。

type
  // 定义节点的数据结构，很重要
  PMyRec = ^TMyRec;

  TMyRec = record
    Caption: WideString;
  end;

5.2 为控件分配数据空间

procedure TForm2.FormCreate(Sender: TObject);
begin
  // 让树形控件知道我们需要多少数据空间。
  VST.NodeDataSize := SizeOf(TMyRec);
  // 初始化节点的条目
  VST.RootNodeCount := 10;
end;

5.3 初始化节点、释放节点

// 初始化节点，如指定复选框及状态
procedure TForm2.VSTInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  Data: PMyRec;
begin
  with Sender do
  begin
    Data         := GetNodeData(Node);
    Data.Caption := Format('等级 %d，索引 %d', [GetNodeLevel(Node), Node.Index]);
    Node.CheckType :=ctCheckBox;
  end;
end;

// 释放节点时要做的一些释放动作
procedure TForm2.VSTFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
  Data: PMyRec;
begin
  Data := Sender.GetNodeData(Node);
  Finalize(Data^);
end;

5.4 节点显示文本

// 指定节点的显示文本
procedure TForm2.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: Integer; TextType: TVSTTextType; var CellText: string);
var
  Data: PMyRec;
begin
  Data := Sender.GetNodeData(Node);
  if Assigned(Data) then
    CellText := Data.Caption;
end;

6. 类似ListView的网格控件

6.1 定义数据结构

// 定义列表头的标题与宽度
const
  COLUMNSTRINGS: array [0 .. 3] of string = ('ID', '区服', '用户名', '密码');
  COLUMNWIDTHS: array [0 .. 3] of Integer = (50, 100, 120, 100);

  // 定义节点数据结构
type
  PAccount = ^TAccount;
  TAccount = packed record
    CheckState: string;
    RecordID: string;
    Server: string;
    UserName: string;
    Password: string;
  end;

6.2 创建列表头

procedure TForm2.FormShow(Sender: TObject);
begin
  VSTColumnsCreate;
end;

// 创建列表头，并显示数据
procedure TForm2.VSTColumnsCreate;
var
  i: Integer;
begin
  VST.BeginUpdate;
  with VST.Header do
  begin
    Height := 23;
    Columns.Clear;
    for i := 0 to high(COLUMNSTRINGS) do
    begin
      Columns.Add;
      Columns[i].Width := COLUMNWIDTHS[i];
      Columns[i].Text  := COLUMNSTRINGS[i];
    end;
  end;
  //对齐方式
  VST.Header.Columns[0].Alignment:= taLeftJustify;
  VST.EndUpdate;
end;

6.3 更改单元格数据

// 修改单元格后更新数据
procedure TForm2.VSTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: Integer;
  NewText: string);
var
  Data: PAccount;
begin
  //Modified := true;
  Data     := Sender.GetNodeData(Node);
  if Assigned(Data) then
  begin
    case Column of
      0:  Data.RecordID := NewText;
      1:  Data.Server := NewText;
      2:  Data.UserName := NewText;
      3:  Data.Password := NewText;
    end;
  end;
  if (Column = 0) and (NewText = '') then
  begin
    MessageDlg('A name is needed for the item.', mtError, [mbOK], 0);
  end;
end;

6.4 实现行复选框

procedure TForm2.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    VST.TreeOptions.MiscOptions:= VST.TreeOptions.MiscOptions + [toCheckSupport];
  end
  else
    VST.TreeOptions.MiscOptions:= VST.TreeOptions.MiscOptions - [toCheckSupport];
end;

6.5 实现拖拽功能

procedure TForm2.VSTDragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: Integer;
  var Allowed: Boolean);
begin
  Allowed := True;
end;

procedure TForm2.VSTDragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState;
  State: TDragState; Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
  Accept := (Source = Sender);
end;

procedure TForm2.VSTDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
  Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
  pSource, pTarget: PVirtualNode;
  attMode: TVTNodeAttachMode;
begin
  pSource := TVirtualStringTree(Source).FocusedNode;
  pTarget := Sender.DropTargetNode;

  case Mode of
    dmNowhere: attMode := amNoWhere;
    dmAbove: attMode := amInsertBefore;
    dmOnNode, dmBelow: attMode := amInsertAfter;
  end;

  Sender.MoveTo(pSource, pTarget, attMode, False);
end;

6.6 保存与加载数据

procedure TForm2.VSTSaveToFile(VST: TVirtualStringTree; FileName: TFileName);
var
  sl         : TStringList;
  Node       : PVirtualNode;
  Data       : PAccount;
  FormatStr  : string;
  ctx        : TRttiContext;
  rttiType   : TRttiType;
  rttiField  : TRttiField;
  FieldValue : TValue;
begin
  if VST.TotalCount = 0 then Exit;
  sl := TStringList.Create;
  try
    Node := VST.GetFirst;
    while Assigned(Node) do
    begin
      Data := VST.GetNodeData(Node);
      // 获取 RTTI 类型信息
      ctx := TRttiContext.Create;
      try
        rttiType := ctx.GetType(TypeInfo(TAccount));
        // 构建一个格式化字符串
        FormatStr := '[';
        for rttiField in rttiType.GetFields do
        begin
          FieldValue := rttiField.GetValue(Data);
          FormatStr := FormatStr + FieldValue.ToString + ' | ';
        end;
        // 去掉最后一个多余的 " | "
        FormatStr := Copy(FormatStr, 1, Length(FormatStr) - 3);
        FormatStr := FormatStr + ' ]';
      finally
        ctx.Free;
      end;
      sl.Add(FormatStr);
      Node := VST.GetNext(Node);
    end;
    sl.SaveToFile(FileName);
  finally
    sl.Free;
  end;
end;

procedure TForm2.VSTLoadFromFile(VST: TVirtualStringTree; FileName: TFileName);
var
  sl            : TStringList;
  i             : Integer;
  Node          : PVirtualNode;
  Data          : PAccount;
  ParsedData    : TStringList;
  FieldCount    : Integer;
  ctx           : TRttiContext;
  rttiType      : TRttiType;
  rttiField     : TRttiField;
begin
  VST.Clear;
  sl := TStringList.Create;
  ParsedData := TStringList.Create;
  try
    sl.LoadFromFile(FileName);
    for i := 0 to sl.Count - 1 do
    begin
      Node := VST.AddChild(nil);
      Data := VST.GetNodeData(Node);
      VST.CheckType[Node] := ctCheckBox;
      // 解析每行数据
      ParsedData.Clear;
      ParsedData.Delimiter := '|';
      ParsedData.StrictDelimiter := True;
      ParsedData.DelimitedText := Trim(Copy(sl[i], 2, Length(sl[i]) - 2));
      // 获取 RTTI 类型信息
      ctx := TRttiContext.Create;
      try
        rttiType := ctx.GetType(TypeInfo(TAccount));
        // 遍历所有字段，并赋值
        FieldCount := ParsedData.Count;
        for rttiField in rttiType.GetFields do
        begin
          if FieldCount > 0 then
          begin
            // 根据字段名称赋值
            rttiField.SetValue(Data, Trim(ParsedData[0]));
            ParsedData.Delete(0);  // 移除已经使用的字段值
          end;
        end;
      finally
        ctx.Free;
      end;
    end;
  finally
    sl.Free;
    ParsedData.Free;
  end;
end;

6.7 列表头排序

//排序
VST.Header.Options := VST.Header.Options + [TVTHeaderOption.hoVisible, TVTHeaderOption.hoHeaderClickAutoSort];
//VST.TreeOptions.AutoOptions := VST.TreeOptions.AutoOptions + [TVTAutoOption.toAutoSort];

//By default sort descrending on date
VST.Header.SortDirection := sdAscending;
//VST.Header.SortColumn := 1;

procedure TForm2.VSTCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode;
Column: Integer; var Result: Integer);
var
NodeData1, NodeData2: PAccount;
Num1, Num2: Integer;
begin
// 获取节点数据
NodeData1 := Sender.GetNodeData(Node1);
NodeData2 := Sender.GetNodeData(Node2);
case Column of
  0:
    begin
      //Result := CompareText(NodeData1.RecordID, NodeData2.RecordID);
      Num1 := StrToIntDef(NodeData1.RecordID, MaxInt);
      Num2 := StrToIntDef(NodeData2.RecordID, MaxInt);
      // 进行数字比较
      Result := Num1 - Num2;
    end;
end;
end;

6.8 添加ico图标

VirtualTreeView的Images属性设置为ImageList1

procedure TForm2.VSTGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
  Column: Integer; var Ghosted: Boolean; var ImageIndex: TImageIndex);
var
  NodeRec: PAccount;
begin
  NodeRec := Sender.GetNodeData(Node);
  if Assigned(NodeRec) then
  begin
    if (Column = 0) then
    begin
      if Kind in [ikNormal, ikSelected] then
      begin
        {case NodeRec.Server of // check the needed status(es)
          1: ImageIndex := 1; // whichever image you need
          2: ImageIndex := 2; // whichever image you need
          // ...
        end; }
        if NodeRec.Server = '广东一区' then
          ImageIndex := 0
        else if NodeRec.Server = '广东二区' then
          ImageIndex := 1;
      end;
    end;
  end;
end;

6.9 过滤显示

procedure TForm2.Button2Click(Sender: TObject);
var
  Node: PVirtualNode;
  Data: PAccount;
begin
  // 遍历所有节点并应用过滤
  Node := VST.GetFirst;
  while Node <> nil do
  begin
    Data := VST.GetNodeData(Node);
    if Data.Server = '广东二区' then
      VST.IsVisible[Node] := False  // 显示节点
    else
      VST.IsVisible[Node] := True;  // 隐藏节点
    Node := VST.GetNext(Node);
  end;
end;

procedure TForm2.Button4Click(Sender: TObject);
var
  Node: PVirtualNode;
  Data: PAccount;
begin
  // 遍历所有节点并应用过滤
  Node := VST.GetFirst;
  while Node <> nil do
  begin
    VST.IsVisible[Node] := True;
    Node := VST.GetNext(Node);
  end;
end;

7. 控件美化

7.1 添加背景图

procedure TForm2.Button1Click(Sender: TObject);
begin
  with OPD do
  begin
    if Execute then
    begin
      VST.Background.LoadFromFile(FileName);
      if CheckBox1.Checked then
        VST.Invalidate
      else
        CheckBox1.Checked := True;
    end;
  end;
end;

procedure TForm2.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    VST.TreeOptions.MiscOptions:= VST.TreeOptions.MiscOptions + [toCheckSupport];
  end
  else
    VST.TreeOptions.MiscOptions:= VST.TreeOptions.MiscOptions - [toCheckSupport];
end;

7.2 每个列表行不同的颜色

procedure TForm2.VSTBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
  Node: PVirtualNode; Column: Integer; CellPaintMode: TVTCellPaintMode; CellRect: TRect;
  var ContentRect: TRect);
begin
  if Odd(Node.Index) then
  begin
    TargetCanvas.Brush.Color := $EEEEFF;
    TargetCanvas.FillRect(CellRect);
  end
  else
  begin
    TargetCanvas.Brush.Color := $FFEEEE;
    TargetCanvas.FillRect(CellRect);
  end;
end;