Lazarus中TreeView导出XML以及XML导入TreeView

本来说是要给自己的某程序加一个xml导出功能，但是自己也没接触过xml，加之delphi和lazarus的xml部分还都不一样，折腾好久（整一天）才解决问题。。

如下是作为导出功能的组件部分：

 unit treexml;

   interface
   uses msxml2_tlb, ComCtrls, dialogs, sysutils, ActiveX;

 type
 // saves TTreeView as XML file.
 TTreeViewToXML = class
   private
     doc: IXMLDOMDocument;
     FTree: TTreeView;

     procedure XMLPopulate(BaseNode: TTreeNode; DataItem: IXMLDOMelement);
   Public
     Constructor Create(Tree: TTreeView);
     procedure SaveToFile(filename: string);
   end;

 // loads TTreeView from XML file
 TXMLToTreeView = class
   private
     doc: IXMLDOMDocument;
     FTree: TTreeView;

     procedure XMLLoad(BaseItem: TTreeNode; DataItem: IXMLDOMNode);
   Public
     Procedure XMLToTree(Tree: TTreeView; Const FileName: String);
   end;

 implementation
 constructor TTreeViewToXML.Create(Tree: TTreeView);
 begin
   FTree := Tree;
 end;

 procedure TTreeViewToXML.XMLPopulate(BaseNode: TTreeNode; DataItem: IXMLDOMelement);
 var
   SubItem: IXMLDOMElement;
   selnode: TTreeNode;
 begin
   SelNode := BaseNode;
   while selnode <> nil do
     begin
       if SelNode.HasChildren then
         begin
           SubItem := doc.CreateElement('Group');
           SubItem.setAttribute('Value', SelNode.Text);
           DataItem.AppendChild(SubItem);
           XMLPopulate(SelNode.GetFirstChild, SubItem);
         end
       else
         begin
           SubItem := doc.CreateElement('Item');
           SubItem.setAttribute('Value', SelNode.Text);
           DataItem.AppendChild(SubItem);
         end;
       SelNode := SelNode.GetNextChild(SelNode);
     end;
 end;

 procedure TTreeViewToXML.SaveToFile(filename: string);
  var
    topnode: IXMLDOMElement;
    selnode: TTreeNode;
  begin
    //create DOM document instance
    CoInitialize(nil);
    doc := CoDOMDocument60.Create;
    doc.async := false;
 //------------------------------------------------------------------------------
    topnode := doc.createElement('<span style="font-family: Arial, Helvetica, sans-serif;">TreeView</span><span style="font-family: Arial, Helvetica, sans-serif;">');//TreeView</span>
    doc.appendChild(topnode);
    selnode := FTree.Items.GetFirstNode;
    XMLPopulate(SelNode, topnode);
    doc.save(FileName);
  end;

  procedure TXMLToTreeView.XMLLoad(BaseItem: TTreeNode; DataItem: IXMLDOMNode);
    var
      item1, item2: IXMLDOMNode;
      attr: IXMLDOMNamedNodeMap;
      CurrItem: TTreeNode;
    begin
      Item1 := DataItem;
      CurrItem := nil;   // compiler complains if I don't do this
      while Item1 <> nil do
        begin
          attr := item1.attributes;
          item2 := attr.nextNode;
          while item2 <> nil do
            begin
              CurrItem := FTree.Items.AddChild(BaseItem, Item2.NodeValue);
              item2 := attr.nextNode;
            end;
          if item1.nodename = 'Group' then
            XMLLoad(CurrItem, Item1.Get_firstChild);
          Item1 := Item1.Get_nextSibling;
        end;
    end;

    Procedure TXMLToTreeView.XMLToTree(Tree: TTreeView; Const FileName: String);
     var
       item1: IXMLDOMNode;
     begin
      //create DOM document instance
       doc := CoDOMDocument60.Create;
       doc.async := false;
       FTree := Tree;
      //------------------------------------------------------------------------------
       if doc.load(FileName) then
         begin
           FTree.Items.BeginUpdate;
           FTree.Items.Clear;
           Item1 := doc.documentElement.Get_firstChild;
           XMLLoad(nil, Item1);
           FTree.Items.EndUpdate;
         end
       else
         begin
           MessageDlg(Format ('Error loading XML document.'# +
                              'Error number: %d'# +
                              'Reason: %s'# +
                              'Line: %d'# +
                              'Column: %d', [doc.parseError.errorCode,
                              doc.parseError.reason,
                              doc.parseError.line,
                              doc.parseError.linePos]), mtError, [mbOK], );
         end;
     end;
  end.

上面的内容如果需要实际使用（比如给每个结点添加参数之类）需要自行修改，上面这个复制并命名treeXML.pas并在你的代码里usetreexml就可以工作了。不过，这个代码依赖msxml2_tlb库，你可以在这里找到这个库适用于lazarus版本的下载。

(追加：刚把博客迁移到博客园，修正文章迁移的问题时发现上面链接失效了，于是搬到这里一份)

使用范例：

 procedure TForm1.Button2Click(Sender: TObject);
 var
   xml:TTreeViewToXML;
 begin
   xml:=TTreeViewToXML.Create(TreeView1);
   xml.SaveToFile('a.xml');
 end;