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.'#13 +
'Error number: %d'#13 +
'Reason: %s'#13 +
'Line: %d'#13 +
'Column: %d', [doc.parseError.errorCode,
doc.parseError.reason,
doc.parseError.line,
doc.parseError.linePos]), mtError, [mbOK], 0);
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;