有没有现成的方法把dfm文件的描述改写成xml格式?如(299分)

有没有现成的方法把dfm文件的描述改写成xml格式?如
object Form1: TForm1
Left = 192
Top = 133
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 12
object Button1: TButton
Left = 232
Top = 168
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end
改写成
<?xml version=&quot;1.0&quot
encoding=&quot;utf-8&quot;?>
<TForm1 name=&quot;form1&quot
left=&quot;192&quot
top=&quot;133&quot
width=&quot;696&quot
height=&quot;480&quot
caption=&quot;form1&quot
color=&quot;clbtnface&quot
>
<TButton name=&quot;button1&quot
left=&quot;232&quot
top=&quot;168&quot
width=&quot;75&quot
height=&quot;25&quot
caption=&quot;Button1&quot;>
</TButton>
</TForm1>
或能提供最有效的方法?

哪位大侠能伸出授助之手!

TNativeXml 控件，他第五个例子就是把 dfm文件读到 xml文件的，你可以去下载一个看看。版本：v2.20

抽时间帮你写了一个Dfm2Xml的简单实现。
窗体上放两个Memo控件，Memo1为Dfm文件内容，Memo2放置Xml生成内容。
希望能对你有所帮助。

代码如下：
procedure TForm1.Button1Click(Sender: TObject);

function ReadControl(ADfmLines, AXmlLines: TStrings;
AStartIndex: Integer): Integer;
var
I, nXmlIndex: Integer;
nPos, nFirstIndex: Integer;
S, sXmlNode: string;
sName, sType: string;
begin
ADfmLines[AStartIndex] := Trim(ADfmLines[AStartIndex]);
nPos := Pos(':', ADfmLines[AStartIndex]);
if nPos = 0 then
begin
Result := AStartIndex;
Exit;
end;
nFirstIndex := Pos(' ', ADfmLines[AStartIndex]);
sName := Trim(Copy(AdfmLines[AStartIndex], nFirstIndex, nPos - nFirstIndex));
sType := Trim(Copy(AdfmLines[AStartIndex], nPos + 1, MaxInt));
I := AStartIndex + 1;
S := Format('<%s Name=%s ', [sType, AnsiQuotedStr(sName, '&quot;')]);
nXmlIndex := AXmlLines.Add(S);
while I < ADfmLines.Count do
begin
ADfmLines := Trim(ADfmLines);
if Pos(':', ADfmLines) <> 0 then
begin
I := ReadControl(ADfmLines, AXmlLines, I);
end;

if Trim(ADfmLines) = 'end' then
begin
Result := I;
Break;
end;
nPos := Pos('=', ADfmLines);
S := S + ' ' + Trim(Copy(ADfmLines, 1, nPos - 1)) + '=' +
AnsiQuotedStr(Trim(Copy(ADfmLines, nPos + 1, MaxInt)), '&quot;');
Inc(I);
end;
S := S + '>';
AXmlLines[nXmlIndex] := S;
AXmlLines.Add(Format('</%s>', [sType]));
end;

begin
ReadControl(Memo1.Lines, Memo2.Lines, 0);
end;

另外，网上也有代码：赋值如下

DFM文件与XML文件互转




作者：佚名 转贴自：本站原创



DFM文件与XML文件互转



dfm文件是Delphi中存储窗体控件信息的，有时为了对大批量的dfm文件操作（如：批量替换控件、作检查等），往往不是太方便。
XML对结构化的数据读写则很强，将文本类型的dfm转为xml后进行操作，再转回dfm存储大大方便了操作。



//DFM to XML
procedure Dfm2Xml(ADfmStrings: TStrings
AXml: IDsXmlDocument);
Var
i: integer;
mStr : string;
mParentNode, mNode : IDsXMLNode;
mObjName, mClass, mObjType: string;
mPropName, mPropValue: string;
mInItem: Boolean
//有Item的也会有End相对，所以要和Object end分开
begin
mInItem := False;
mParentNode := AXML;
for i:=0 to ADfmStrings.Count - 1 do
begin
mStr := trim(ADfmStrings.Strings);
//对象开始
if (copy(mStr, 1, 6) = 'object') or (copy(mStr, 1, 9) = 'inherited') then
begin
//先写入属性 - 如果还有属性没有写
if mPropName <> '' then
begin
mNode := AXml.createElement(mPropName);
mNode.text := mPropValue;
mParentNode.appendChild(mNode);
mPropName := '';
end;
mObjType := CutToken(mStr, ' ')
//Type: object or inherited
mObjName := CutToken(mStr, ': ')
//ObjName: Ex. frmCmsI03
mClass := mStr
//ClassName: Ex. TButton
mNode := AXml.createElement(mObjName);
(mNode as IDsXmlElement).setAttribute('ObjType', mObjType);
(mNode as IDsXmlElement).setAttribute('Class', mClass);
mParentNode.appendChild(mNode);
mParentNode := mNode;
end
//对象结束
else if (mStr = 'end') and (not mInItem) then
begin
//先写入属性
if mPropName <> '' then
begin
mNode := AXml.createElement(mPropName);
mNode.text := mPropValue;
mParentNode.appendChild(mNode);
mPropName := '';
end;
mParentNode := mParentNode.parentNode;
end
//属性处理
else
begin
//有 = 说明是一个属性的新的开始
if (Pos(' = ', mStr) > 0) and (not mInItem) then
begin
//先写入属性
if mPropName <> '' then
begin
mNode := AXml.createElement(mPropName);
mNode.text := mPropValue;
mParentNode.appendChild(mNode);
end;
mPropName := CutToken(mStr, ' = ');
mPropValue := CutToken(mStr, ' = ');
end
else //说明这个属性可能有多行
mPropValue := mPropValue + '#13#10' + mStr;
if mStr = 'item' then mInItem := True;
if mStr = 'end' then mInItem := False;
end;
end;
end;
//XML to DFM
procedure Xml2Dfm(AXml: IDsXmlDocument
ADfmStrings: TStrings);
procedure Node2Dfm(ANode: IDsXMLNode
oString: TStrings
IdentSpace: string);
Var
mObjName, mClass, mObjType: string;
mPropName, mPropValue: string;
mNode : IDsXMLNode;
i: integer;
mVar : Variant;
begin
mObjName := (ANode as IDsXmlElement).NodeName;
mClass := (ANode as IDsXmlElement).getAttribute('Class');
mObjType := (ANode as IDsXmlElement).getAttribute('ObjType');
//写入Object begin
oString.Add(Format('%s%s %s: %s', [IdentSpace, mObjType, mObjName, mClass]));
//写入属性
for i:= 0 to ANode.childNodes.length - 1 do
begin
mNode := ANode.childNodes.item;
//Has Child 说明是一个新的对象
mVar := (mNode as IDsXmlElement).getAttribute('ObjType');
if not varIsNull(mVar) then
Node2Dfm(mNode, oString, IdentSpace + ' ')
//是属性，写进去就好了．
else
begin
mPropName := mNode.nodeName;
mPropValue := mNode.text;
mPropValue := StringReplace(mPropValue, '#13#10', #13#10, [rfReplaceAll]);
//写入：缩进
oString.Add(Format('%s%s = %s', [IdentSpace+' ', mPropName, mPropValue]));
end;
end;
//写入End
oString.Add(Format('%send', [IdentSpace]));
end;

begin
Node2Dfm(AXml.Get_documentElement, ADfmStrings, '');
end;
用到的类型：

uses
MSXML2_TLB;
//类型自己重新定义过
type
IDsXmlDocument = IXMLDOMDocument2;
IDsXmlNode = IXMLDOMNode;
IDsXmlElement = IXMLDOMElement;
IDsXmlNodeList = IXMLDOMNodeList;

多谢谢两位帮助