VirtualStringTree 动态建树/Checktree

//相关生成代码，VirtualStringTree有点难入门，研究了二天半，终于入门了。

PTagCustomListItem = ^TTagCustomListItem;

TTagCustomListItem = record
    Name: string;
    Id: string;
end;

var
MainFrm: TMainFrm;
SysPath: string;
List: TStringList;

implementation

{$R *.dfm}

uses fDMfrm;

procedure TMainFrm.BuildTree;
begin
List.Clear;
Self.VirtualStringTree1.BeginUpdate;
Self.VirtualStringTree1.Clear;
DMfrm.UniQuery1.First;
while not DMfrm.UniQuery1.Eof do
begin
    AddTreeNode;
    DMfrm.UniQuery1.Next;
end;
Self.VirtualStringTree1.EndUpdate;

   {
      注：在这里把数据添加进树后，树里并不能显示出结点
      要在几个事件里写代码才行：
      OnInitNode:在这个事件里初始化结点，如指定复选框以及状态
      OnGetText:在这个事件里指定结点的显示文本
      OnGetPopupMenu:在这个事件里指定下拉菜单
      OnGetImageIndex:指定结点的图片索引
      OnFreeNode:释放结点时您要做的一些释放动作

      通过这些事件，才能把结点的显示情况描述清楚。而您的
      结构体是用来持有您每个结点的数据的。
   }
end;

procedure TMainFrm.AddTreeNode;
var
index: integer;
RootNode, RNode, PRNode: PVirtualNode;
MyRec: PTagCustomListItem;
begin
if DMfrm.UniQuery1.FieldByName('M_FatherCode').Value = '0' then
begin
    RootNode := Self.VirtualStringTree1.AddChild(nil);
    RootNode.CheckType := ctTriStateCheckBox; // ctCheckbox
    RootNode.CheckState := csUncheckedNormal;
    MyRec := Self.VirtualStringTree1.GetNodeData(RootNode);
    MyRec^.Name := DMfrm.UniQuery1.FieldByName('M_name').Value;
    MyRec^.Id := DMfrm.UniQuery1.FieldByName('M_ID').Value;
end
else
begin
    Index := List.IndexOf(DMfrm.UniQuery1.FieldByName('M_FatherCode').AsString);
    RNode := Self.VirtualStringTree1.AddChild
      (PVirtualNode(List.Objects[Index]));
    RNode.CheckType := ctTriStateCheckBox; // ctCheckbox
    RNode.CheckState := csUncheckedNormal;
    MyRec := Self.VirtualStringTree1.GetNodeData(RNode);
    MyRec^.Name := DMfrm.UniQuery1.FieldByName('M_name').Value;
    MyRec^.Id := DMfrm.UniQuery1.FieldByName('M_ID').Value;
end;
List.AddObject(DMfrm.UniQuery1.FieldByName('M_ID').AsString,
    TObject(RootNode));
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
DMfrm.UniQuery1.Close;
DMfrm.UniQuery1.Open;

//此句非常关键,一开始，因这一句没写，N次报内存出错。我查了好久资料才试出来。默认为-1.没有设NodeDataSize的值肯定报错！至于为什么定为记录数呢，你遍历时就会明白。定少了，遍历肯定报错
Self.VirtualStringTree1.NodeDataSize := DMfrm.UniQuery1.RecordCount;
BuildTree;
end;

//树的遍历

procedure TMainFrm.Button2Click(Sender: TObject);
var
_pNodeData: PTagCustomListItem;
Node: PVirtualNode;
begin
Self.Memo1.Clear;
Node := Self.VirtualStringTree1.GetFirst(False); // GetFirstSelected 与 GetNextSelected(Node) 的做法。
_pNodeData := Self.VirtualStringTree1.GetNodeData(Node);
while Assigned(_pNodeData) do
begin
    if Node.CheckState in [csMixedNormal, csCheckedNormal] then
    begin
      Self.Memo1.Lines.Add(_pNodeData^.Id);
    end;
    Node := Self.VirtualStringTree1.GetNext(Node);
    _pNodeData := Self.VirtualStringTree1.GetNodeData(Node);
end;
end;

{

结点显示的图片索引。注意：要在结点显示图片必须TreeOptions.MiscOptions包含toCheckSuppot
示例取点击结点的数据。注意：TreeOptions.SelectionOptions必须包含toRightClickSelect

}

procedure TMainFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
Node: PVirtualNode;
begin
// 释放，我想出来的有效方法，但想不明白为什么要这样,(加了ReportMemoryLeaksOnShutdown:=True),不然就报内存泄漏
Node := Self.VirtualStringTree1.GetFirst;
while Assigned(Node) do
begin
    Node := Self.VirtualStringTree1.GetNext(Node);
end;
//
if List <> nil then
begin
    List.Free;
    List := nil;
end;
end;

procedure TMainFrm.FormCreate(Sender: TObject);
begin
SysPath := ExtractFilePath(ParamStr(0));
List := TStringList.Create;
end;

procedure TMainFrm.VirtualStringTree1FreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PTagCustomListItem;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) then
    Finalize(Data^);
end;

procedure TMainFrm.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
_pNodeData: PTagCustomListItem;
begin
_pNodeData := Sender.GetNodeData(Node);

if Assigned(_pNodeData) then
    CellText := _pNodeData^.Name;
end;

{建多列
Data := Sender.GetNodeData(Node);
if Assigned(Data) then
begin
    case Column of
      0:
        CellText := Data^.ID;
      1:
        CellText := Data^.Name;
      2:
        CellText := FormatFloat('0.00', Data^.NUM);
      3:
        CellText := Data^.BZ;
    end;
end;
}

http://hi.baidu.com/vbz007/blog/item/c6f3efd378f250d1a8ec9a73.html