implemented streaming components to TXMLConfig

git-svn-id: trunk@9090 -

components/codetools/laz_xmlcfg.pas

@@ -79,7 +79,7 @@ type
                                      const AValue, DefValue: extended);
     procedure DeletePath(const APath: string);
     procedure DeleteValue(const APath: string);
-    property Modified: Boolean read FModified;
+    property Modified: Boolean read FModified write FModified;
   published
     property Filename: String read FFilename write SetFilename;
     property Document: TXMLDocument read doc;

components/codetools/laz_xmlstreaming.pas

@@ -46,7 +46,7 @@ type
     procedure StackPop;
     function GetPropertyElement(const TypeName: String): TDOMElement;
   public
-    constructor Create(ADoc: TDOMDocument);
+    constructor Create(ADoc: TDOMDocument; const APath: string; Append: Boolean);
 
     { Begin/End markers. Those ones who don't have an end indicator, use
       "EndList", after the occurrence named in the comment. Note that this
@@ -134,7 +134,7 @@ begin
   Writer:=nil;
   try
     XMLDocument:=TXMLDocument.Create;
-    Driver:=TXMLObjectWriter.Create(XMLDocument);
+    Driver:=TXMLObjectWriter.Create(XMLDocument,'fcl-persistent',true);
     Writer:=TWriter.Create(Driver);
     Writer.WriteDescendent(AComponent,nil);
     WriteXMLFile(XMLDocument,AStream);
@@ -190,12 +190,65 @@ begin
     Result := nil;
 end;
 
-constructor TXMLObjectWriter.Create(ADoc: TDOMDocument);
+constructor TXMLObjectWriter.Create(ADoc: TDOMDocument;
+  const APath: string; Append: Boolean);
+var
+  Node: TDOMNode;
+  PathLen: Integer;
+  StartPos: Integer;
+  EndPos: LongInt;
+  NodeName: string;
+  Child: TDOMNode;
+  ParentNode: TDOMNode;
 begin
   inherited Create;
   FDoc := ADoc;
-  FRootEl := FDoc.CreateElement('fcl-persistent');
-  FDoc.AppendChild(FRootEl);
+
+  Node := Doc.DocumentElement;
+  PathLen:=length(APath);
+  StartPos:=1;
+  while True do begin
+    EndPos:=StartPos;
+    while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos);
+    if EndPos>StartPos then begin
+      SetLength(NodeName,EndPos-StartPos);
+      Move(APath[StartPos],NodeName[1],EndPos-StartPos);
+      StartPos:=EndPos+1;
+      Child := Node.FindNode(NodeName);
+      if not Assigned(Child) then
+      begin
+        Child := Doc.CreateElement(NodeName);
+        Node.AppendChild(Child);
+      end;
+      Node := Child;
+    end else if EndPos>PathLen then begin
+      break;
+    end else begin
+      StartPos:=EndPos+1;
+    end;
+  end;
+  if Node is TDOMElement then
+    FRootEl:=TDOMElement(Node)
+  else
+    FRootEl:=nil;
+
+  NodeName:='fcl-persistent';
+  ParentNode:=nil;
+  if (not Append) and (FRootEl<>nil) then begin
+    NodeName:=FRootEl.NodeName;
+    ParentNode:=FRootEl.ParentNode;
+    if ParentNode<>nil then
+      ParentNode.RemoveChild(FRootEl)
+    else
+      FRootEl.Free;
+    FRootEl:=nil;
+  end;
+  if FRootEl=nil then
+    FRootEl := FDoc.CreateElement(NodeName);
+  if ParentNode=nil then
+    FDoc.AppendChild(FRootEl)
+  else
+    ParentNode.AppendChild(FRootEl);
 end;
 
 procedure TXMLObjectWriter.BeginCollection;

examples/xmlstreaming/mainunit.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TStreamAsXMLForm','FORMDATA',[
   'TPF0'#16'TStreamAsXMLForm'#15'StreamAsXMLForm'#4'Left'#3'N'#1#6'Height'#3#178
   +#1#3'Top'#3#182#0#5'Width'#3#237#1#18'HorzScrollBar.Page'#3#236#1#18'VertScr'

examples/xmlstreaming/mainunit.pas

@@ -5,10 +5,32 @@ unit MainUnit;
 interface
 
 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Laz_XMLStreaming, DOM, laz_xmlcfg, Buttons;
+  Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
+  StdCtrls, Laz_XMLStreaming, Laz_DOM, laz_xmlcfg, Buttons;
 
 type
+  TMyEnum = (myEnum1, myEnum2, myEnum3);
+  TMySet = set of TMyEnum;
+
+  { TMyComponent }
+
+  TMyComponent = class(TComponent)
+  private
+    FMyDouble: Double;
+    FMyEnum: TMyEnum;
+    FMyInteger: integer;
+    FMySet: TMySet;
+    FMyString: string;
+    FMyWideString: widestring;
+  public
+    property MyDouble: Double read FMyDouble write FMyDouble;
+    property MyWideString: widestring read FMyWideString write FMyWideString;
+    property MyInteger: integer read FMyInteger write FMyInteger;
+    property MyString: string read FMyString write FMyString;
+    property MyEnum: TMyEnum read FMyEnum write FMyEnum;
+    property MySet: TMySet read FMySet write FMySet;
+  end;
+
 
   { TStreamAsXMLForm }
 
@@ -27,26 +49,62 @@ type
 var
   StreamAsXMLForm: TStreamAsXMLForm;
 
-function CreateXMLWriter(ADoc: TDOMDocument;
-  var DestroyDriver: boolean): TWriter;
+function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
+  Append: Boolean; var DestroyDriver: boolean): TWriter;
+procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
+  AComponent: TComponent);
 
 implementation
 
-function CreateXMLWriter(ADoc: TDOMDocument;
-  var DestroyDriver: boolean): TWriter;
+function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
+  Append: Boolean; var DestroyDriver: boolean): TWriter;
 var
   Driver: TAbstractObjectWriter;
 begin
-  Driver:=TXMLObjectWriter.Create(ADoc);
+  Driver:=TXMLObjectWriter.Create(ADoc,Path,Append);
   DestroyDriver:=true;
   Result:=TWriter.Create(Driver);
 end;
 
+procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
+  AComponent: TComponent);
+var
+  Writer: TWriter;
+  DestroyDriver: boolean;
+begin
+  Writer:=nil;
+  DestroyDriver:=false;
+  try
+    Writer:=CreateXMLWriter(XMLConfig.Document,Path,false,DestroyDriver);
+    XMLConfig.Modified:=true;
+    Writer.WriteRootComponent(AComponent);
+    XMLConfig.Flush;
+  finally
+    if DestroyDriver then
+      Writer.Driver.Free;
+    Writer.Free;
+  end;
+end;
+
 { TStreamAsXMLForm }
 
 procedure TStreamAsXMLForm.FormCreate(Sender: TObject);
+var
+  MyComponent: TMyComponent;
 begin
   Filename:='test.xml';
+
+  MyComponent:=TMyComponent.Create(Self);
+  with MyComponent do begin
+    Name:='MyComponent';
+    MyDouble:=-1.23456789;
+    MyEnum:=myEnum2;
+    MySet:=[myEnum1,myEnum3];
+    MyString:='Some text as string';
+    MyWideString:='Some text as widestring';
+    MyInteger:=1234;
+  end;
+
   StreamComponents;
 end;
 
@@ -59,22 +117,21 @@ end;
 procedure TStreamAsXMLForm.StreamComponents;
 var
   XMLConfig: TXMLConfig;
-  Writer: TWriter;
-  DestroyDriver: boolean;
+  sl: TStringList;
 begin
+  DebugLn('TStreamAsXMLForm.StreamComponents ',Filename);
   XMLConfig:=TXMLConfig.Create(Filename);
-  Writer:=nil;
-  DestroyDriver:=false;
   try
-    Writer:=CreateXMLWriter(XMLConfig.Document,DestroyDriver);
-    Writer.WriteRootComponent(GroupBox1);
+    WriteComponentToXMLConfig(XMLConfig,'Component',GroupBox1);
     XMLConfig.Flush;
   finally
-    if DestroyDriver then
-      Writer.Driver.Free;
-    Writer.Free;
     XMLConfig.Free;
   end;
+  
+  sl:=TStringList.Create;
+  sl.LoadFromFile(Filename);
+  DebugLn('TStreamAsXMLForm.StreamComponents ',sl.Text);
+  sl.Free;
 end;
 
 initialization