支持xml的控件
来源:百度文库 编辑:神马文学网 时间:2024/03/29 02:10:48
以前帮别人写的一个例子,你可以参考一下 :)
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleServer, MSXML2_TLB, StdCtrls, AppEvnts, ComCtrls, XMLTreeView;
type
EXMLError = class(Exception);
EXMLLoadError = class(EXMLError);
EXMLSaveError = class(EXMLError);
EXMLParseError = class(EXMLError);
type
TfrmMain = class(TForm)
memXML: TMemo;
btnLoad: TButton;
dlgOpen: TOpenDialog;
AppEvents: TApplicationEvents;
lblTagName: TLabel;
edtTagName: TEdit;
lstChildren: TListBox;
btnTree: TButton;
treeNode: TTreeView;
dlgSave: TSaveDialog;
btnSave: TButton;
XMLTree: TXMLTreeView;
btnLoadFromFile: TButton;
btnSaveToFile: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure AppEventsException(Sender: TObject; E: Exception);
procedure edtTagNameChange(Sender: TObject);
procedure btnTreeClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnLoadFromFileClick(Sender: TObject);
procedure btnSaveToFileClick(Sender: TObject);
private
xmlDoc: IXMLDOMDocument2;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
xmlDoc := CoDOMDocument.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
xmlDoc := nil;
end;
procedure TfrmMain.btnLoadClick(Sender: TObject);
begin
with dlgOpen, xmlDoc do
if Execute then
begin
if not Load(FileName) then
raise EXMLLoadError.CreateFmt('载入XML文档失败!', [FileName])
else
with memXML.Lines do
begin
Clear;
Text := documentElement.xml;
end;
end;
end;
procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
with dlgSave do
if Execute then
xmlDoc.Save(FileName);
end;
procedure TfrmMain.AppEventsException(Sender: TObject; E: Exception);
begin
if E is EXMLError then
with xmlDoc.parseError do
begin
MessageDlg(Format('处理文档"%s"时因"%s"发生0x%x号错误在第%d行%d个字符(全文第%d个字符)'#13#10'错误文本: %s'#13#10'提示信息: %s',
[url, reason, errorCode, line, linepos, filepos + 1, srcText, E.Message]), mtError, [mbAbort], 0);
end
else
Application.ShowException(E);
end;
procedure TfrmMain.edtTagNameChange(Sender: TObject);
var
I: Integer;
begin
if edtTagName.Text <> '' then
with xmlDoc.getElementsByTagName(UpperCase(edtTagName.Text)) do
with lstChildren.Items do
begin
Clear;
for I := 0 to length - 1 do
Add(item[I].text);
end;
end;
procedure TfrmMain.btnTreeClick(Sender: TObject);
procedure DoTree(ANode: IXMLDOMNode; Parent: TTreeNode);
var
I: Integer;
CurNode: TTreeNode;
begin
with ANode do
case nodeType of
NODE_ELEMENT:
begin
if ParentNode = nil then
CurNode := treeNode.Items.Add(nil, nodeName)
else
CurNode := treeNode.Items.AddChild(Parent, nodeName);
if hasChildNodes then
with childNodes do
for I := 0 to length - 1 do
DoTree(IXMLDOMElement(item[I]), CurNode);
end;
NODE_TEXT:
treeNode.Items.AddChild(Parent, ANode.text);
end;
end;
begin
with treeNode.Items do
begin
Clear;
BeginUpdate;
DoTree(xmlDoc.documentElement, nil);
treeNode.FullExpand;
EndUpdate;
end;
end;
procedure TfrmMain.btnLoadFromFileClick(Sender: TObject);
begin
with dlgOpen do
if Execute then
XMLTree.LoadFromFile(FileName);
end;
procedure TfrmMain.btnSaveToFileClick(Sender: TObject);
begin
with dlgSave do
if Execute then
XMLTree.SaveToFile(FileName);
end;
end.
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleServer, MSXML2_TLB, StdCtrls, AppEvnts, ComCtrls, XMLTreeView;
type
EXMLError = class(Exception);
EXMLLoadError = class(EXMLError);
EXMLSaveError = class(EXMLError);
EXMLParseError = class(EXMLError);
type
TfrmMain = class(TForm)
memXML: TMemo;
btnLoad: TButton;
dlgOpen: TOpenDialog;
AppEvents: TApplicationEvents;
lblTagName: TLabel;
edtTagName: TEdit;
lstChildren: TListBox;
btnTree: TButton;
treeNode: TTreeView;
dlgSave: TSaveDialog;
btnSave: TButton;
XMLTree: TXMLTreeView;
btnLoadFromFile: TButton;
btnSaveToFile: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure AppEventsException(Sender: TObject; E: Exception);
procedure edtTagNameChange(Sender: TObject);
procedure btnTreeClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnLoadFromFileClick(Sender: TObject);
procedure btnSaveToFileClick(Sender: TObject);
private
xmlDoc: IXMLDOMDocument2;
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
implementation
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
xmlDoc := CoDOMDocument.Create;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
xmlDoc := nil;
end;
procedure TfrmMain.btnLoadClick(Sender: TObject);
begin
with dlgOpen, xmlDoc do
if Execute then
begin
if not Load(FileName) then
raise EXMLLoadError.CreateFmt('载入XML文档失败!', [FileName])
else
with memXML.Lines do
begin
Clear;
Text := documentElement.xml;
end;
end;
end;
procedure TfrmMain.btnSaveClick(Sender: TObject);
begin
with dlgSave do
if Execute then
xmlDoc.Save(FileName);
end;
procedure TfrmMain.AppEventsException(Sender: TObject; E: Exception);
begin
if E is EXMLError then
with xmlDoc.parseError do
begin
MessageDlg(Format('处理文档"%s"时因"%s"发生0x%x号错误在第%d行%d个字符(全文第%d个字符)'#13#10'错误文本: %s'#13#10'提示信息: %s',
[url, reason, errorCode, line, linepos, filepos + 1, srcText, E.Message]), mtError, [mbAbort], 0);
end
else
Application.ShowException(E);
end;
procedure TfrmMain.edtTagNameChange(Sender: TObject);
var
I: Integer;
begin
if edtTagName.Text <> '' then
with xmlDoc.getElementsByTagName(UpperCase(edtTagName.Text)) do
with lstChildren.Items do
begin
Clear;
for I := 0 to length - 1 do
Add(item[I].text);
end;
end;
procedure TfrmMain.btnTreeClick(Sender: TObject);
procedure DoTree(ANode: IXMLDOMNode; Parent: TTreeNode);
var
I: Integer;
CurNode: TTreeNode;
begin
with ANode do
case nodeType of
NODE_ELEMENT:
begin
if ParentNode = nil then
CurNode := treeNode.Items.Add(nil, nodeName)
else
CurNode := treeNode.Items.AddChild(Parent, nodeName);
if hasChildNodes then
with childNodes do
for I := 0 to length - 1 do
DoTree(IXMLDOMElement(item[I]), CurNode);
end;
NODE_TEXT:
treeNode.Items.AddChild(Parent, ANode.text);
end;
end;
begin
with treeNode.Items do
begin
Clear;
BeginUpdate;
DoTree(xmlDoc.documentElement, nil);
treeNode.FullExpand;
EndUpdate;
end;
end;
procedure TfrmMain.btnLoadFromFileClick(Sender: TObject);
begin
with dlgOpen do
if Execute then
XMLTree.LoadFromFile(FileName);
end;
procedure TfrmMain.btnSaveToFileClick(Sender: TObject);
begin
with dlgSave do
if Execute then
XMLTree.SaveToFile(FileName);
end;
end.
支持xml的控件
全面支持XML的DB2 9
vs2008控件ID修改及.NET支持
Windows Presentation Foundation(WPF)中的数据绑定(使用XmlDataProvider作控件绑定之二:使用外部URL的XML文件)
使用控件模板定制控件的观感
使SQL Server数据支持 XML SQL server技术交流
我的控件笔记
ListCtrl控件的用法
日历控件的实现
SHOCKWAVE控件的调出
SHOCKWAVE控件的调出
xml
vs 2005 的控件区别
如何改变控件的颜色
VB--DataGrid 控件的使用
delphi6?OCX控件的制作
vb.net的ListBox控件
vb.net的Combobox控件
善用 .NET 的 PropertyGrid 控件
ListCtrl控件的用法1
类似资源管理器的ocx控件
Vb中控件的自动排列-VB控件
Visual Basic 6.0 控件和 .NET 控件的区别(续)
获取GridView/DataList控件中的子控件的方法