completed xml writer for components

git-svn-id: trunk@9112 -
2026-01-06 01:00:51 +01:00 · 2006-04-10 10:13:37 +00:00 · 2006-04-10 10:13:37 +00:00 · 0a08475ff7
commit 0a08475ff7
parent 770fa8ffb2
4 changed files with 164 additions and 50 deletions
--- a/components/codetools/laz_xmlstreaming.pas
+++ b/components/codetools/laz_xmlstreaming.pas
@ -21,7 +21,7 @@ unit Laz_XMLStreaming;

 interface

-uses SysUtils, Classes, TypInfo, Laz_DOM, Laz_XMLWrite;
+uses SysUtils, Classes, TypInfo, FileProcs, Laz_DOM, Laz_XMLWrite;

 type

@ -86,7 +86,7 @@ type
    FDoc: TDOMDocument;
    FRootEl: TDOMElement;
  public
-    constructor Create(ADoc: TDOMDocument);
+    constructor Create(ADoc: TDOMDocument; const APath: string);
    destructor Destroy; override;

    { All ReadXXX methods are called _after_ the value type has been read! }
@ -161,10 +161,12 @@ begin
    StackEl := TXMLObjectWriterStackEl.Create;
    StackEl.Parent := FRootEl;
  end;
+  //DebugLn('TXMLObjectWriter.StackPush ',dbgs(FStack.Count));
 end;

 procedure TXMLObjectWriter.StackPop;
 begin
+  //DebugLn('TXMLObjectWriter.StackPop ',dbgs(FStack.Count));
  StackEl.Free;
  if FStack.Count > 0 then
  begin
@ -178,7 +180,8 @@ begin
  end;
 end;

-function TXMLObjectWriter.GetPropertyElement(const TypeName: String): TDOMElement;
+function TXMLObjectWriter.GetPropertyElement(const TypeName: String
+  ): TDOMElement;
 begin
  if not Assigned(StackEl.Element) then
  begin
@ -253,6 +256,7 @@ end;

 procedure TXMLObjectWriter.BeginCollection;
 begin
+  GetPropertyElement('collectionproperty');
  StackPush;
  StackEl.Element := FDoc.CreateElement('collection');
  StackEl.Parent.AppendChild(StackEl.Element);
@ -260,6 +264,8 @@ end;

 procedure TXMLObjectWriter.BeginComponent(Component: TComponent; Flags: TFilerFlags;
  ChildPos: Integer);
+// TWriter expects to push two elements on the stack, which are popped by
+// two EndList calls.
 begin
  StackPush;
  StackEl.Element := FDoc.CreateElement('component');
@ -286,6 +292,7 @@ procedure TXMLObjectWriter.EndList;
 begin
  if StackEl.ElType = elPropertyList then
  begin
+    // end the property list and start the children list
    if not StackEl.Element.HasChildNodes then
      StackEl.Parent.RemoveChild(StackEl.Element);
    StackPop;
@ -296,15 +303,18 @@ begin
    StackEl.ElType := elChildrenList;
  end else if StackEl.ElType = elChildrenList then
  begin
+    // end the children list and the component
    if not StackEl.Element.HasChildNodes then
      StackEl.Parent.RemoveChild(StackEl.Element);
-    StackPop;
+    StackPop; // end children
+    StackPop; // end component
  end else
    StackPop;
 end;

 procedure TXMLObjectWriter.BeginProperty(const PropName: String);
 begin
+  //DebugLn('TXMLObjectWriter.BeginProperty "',PropName,'"');
  StackPush;
  StackEl.CurName := PropName;
 end;
@ -371,19 +381,18 @@ procedure TXMLObjectWriter.WriteSet(Value: LongInt; SetType: Pointer);
 var
  i: Integer;
  Mask: LongInt;
+  s: String;
 begin
-  StackPush;
-  StackEl.Element := FDoc.CreateElement('set');
-  StackEl.Parent.AppendChild(StackEl.Element);
-
  Mask := 1;
-  for i := 0 to 31 do
-  begin
-    if (Value and Mask) <> 0 then
-      GetPropertyElement('enum')['value'] := GetEnumName(PTypeInfo(SetType), i);
+  s:='';
+  for i := 0 to 31 do begin
+    if (Value and Mask) <> 0 then begin
+      if s<>'' then s:=s+',';
+      s:=s+GetEnumName(PTypeInfo(SetType), i);
+    end;
    Mask := Mask shl 1;
  end;
-  EndList;
+  GetPropertyElement('set')['value'] := s;
 end;

 procedure TXMLObjectWriter.WriteString(const Value: String);
@ -400,12 +409,52 @@ end;

 { TXMLObjectReader }

-constructor TXMLObjectReader.Create(ADoc: TDOMDocument);
+constructor TXMLObjectReader.Create(ADoc: TDOMDocument; const APath: string);
+var
+  Node: TDOMNode;
+  PathLen: Integer;
+  StartPos: Integer;
+  EndPos: LongInt;
+  NodeName: string;
+  Child: TDOMNode;
+
+  procedure RaiseMissingNode;
+  begin
+    raise Exception.Create('XML node not found '+APath);
+  end;
+  
+  procedure RaiseNotDOMElement;
+  begin
+    raise Exception.Create('invalid XML node '+APath);
+  end;
+
 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
+        RaiseMissingNode;
+      Node := Child;
+    end else if EndPos>PathLen then begin
+      break;
+    end else begin
+      StartPos:=EndPos+1;
+    end;
+  end;
+  if not (Node is TDOMElement) then
+    RaiseNotDOMElement;
+  FRootEl:=TDOMElement(Node)
 end;

 destructor TXMLObjectReader.Destroy;
--- a/examples/xmlstreaming/mainunit.lfm
+++ b/examples/xmlstreaming/mainunit.lfm
@ -1,32 +1,52 @@
 object StreamAsXMLForm: TStreamAsXMLForm
-  Left = 334
-  Height = 434
-  Top = 182
-  Width = 493
-  HorzScrollBar.Page = 492
-  VertScrollBar.Page = 433
+  ActiveControl = Button1
  Caption = 'StreamAsXMLForm'
  ClientHeight = 434
  ClientWidth = 493
  OnCreate = FormCreate
-  PixelsPerInch = 95
+  PixelsPerInch = 112
+  HorzScrollBar.Page = 492
+  VertScrollBar.Page = 433
+  Left = 334
+  Height = 434
+  Top = 182
+  Width = 493
  object GroupBox1: TGroupBox
-    Left = 16
-    Height = 105
-    Top = 16
-    Width = 185
    Caption = 'GroupBox1'
-    ClientHeight = 88
-    ClientWidth = 181
+    ClientHeight = 133
+    ClientWidth = 271
    TabOrder = 0
+    Left = 16
+    Height = 150
+    Top = 16
+    Width = 275
    object Button1: TButton
+      BorderSpacing.InnerBorder = 2
+      Caption = 'Button1'
+      TabOrder = 0
      Left = 33
      Height = 25
      Top = 15
      Width = 75
-      BorderSpacing.InnerBorder = 2
-      Caption = 'Button1'
-      TabOrder = 0
+    end
+    object GroupBox2: TGroupBox
+      Caption = 'GroupBox2'
+      ClientHeight = 80
+      ClientWidth = 128
+      TabOrder = 1
+      Left = 123
+      Height = 97
+      Top = 17
+      Width = 132
+      object Button2: TButton
+        BorderSpacing.InnerBorder = 2
+        Caption = 'Button2'
+        TabOrder = 0
+        Left = 27
+        Height = 25
+        Top = 21
+        Width = 75
+      end
    end
  end
 end
--- a/examples/xmlstreaming/mainunit.lrs
+++ b/examples/xmlstreaming/mainunit.lrs
@ -1,11 +1,18 @@
+{ 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'
-  +'ollBar.Page'#3#177#1#7'Caption'#6#15'StreamAsXMLForm'#12'ClientHeight'#3#178
-  +#1#11'ClientWidth'#3#237#1#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2
-  +'_'#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#16#6'Height'#2'i'#3'Top'#2#16#5'Wi'
-  +'dth'#3#185#0#7'Caption'#6#9'GroupBox1'#12'ClientHeight'#2'X'#11'ClientWidth'
-  +#3#181#0#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left'#2'!'#6'Height'#2#25
-  +#3'Top'#2#15#5'Width'#2'K'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7
-  +'Button1'#8'TabOrder'#2#0#0#0#0#0
+  'TPF0'#16'TStreamAsXMLForm'#15'StreamAsXMLForm'#13'ActiveControl'#7#7'Button1'
+  +#7'Caption'#6#15'StreamAsXMLForm'#12'ClientHeight'#3#178#1#11'ClientWidth'#3
+  +#237#1#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'p'#18'HorzScrollBar.'
+  +'Page'#3#236#1#18'VertScrollBar.Page'#3#177#1#4'Left'#3'N'#1#6'Height'#3#178
+  +#1#3'Top'#3#182#0#5'Width'#3#237#1#0#9'TGroupBox'#9'GroupBox1'#7'Caption'#6#9
+  +'GroupBox1'#12'ClientHeight'#3#133#0#11'ClientWidth'#3#15#1#8'TabOrder'#2#0#4
+  +'Left'#2#16#6'Height'#3#150#0#3'Top'#2#16#5'Width'#3#19#1#0#7'TButton'#7'But'
+  +'ton1'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7'Button1'#8'TabOrder'
+  +#2#0#4'Left'#2'!'#6'Height'#2#25#3'Top'#2#15#5'Width'#2'K'#0#0#9'TGroupBox'#9
+  +'GroupBox2'#7'Caption'#6#9'GroupBox2'#12'ClientHeight'#2'P'#11'ClientWidth'#3
+  +#128#0#8'TabOrder'#2#1#4'Left'#2'{'#6'Height'#2'a'#3'Top'#2#17#5'Width'#3#132
+  +#0#0#7'TButton'#7'Button2'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7
+  +'Button2'#8'TabOrder'#2#0#4'Left'#2#27#6'Height'#2#25#3'Top'#2#21#5'Width'#2
+  +'K'#0#0#0#0#0
 ]);
--- a/examples/xmlstreaming/mainunit.pas
+++ b/examples/xmlstreaming/mainunit.pas
@ -11,25 +11,41 @@ uses
 type
  TMyEnum = (myEnum1, myEnum2, myEnum3);
  TMySet = set of TMyEnum;
+  
+  { TMyCollectionItem }

+  TMyCollectionItem = class(TCollectionItem)
+  private
+    FMyString: string;
+  published
+    property MyString: string read FMyString write FMyString;
+  end;
+  
  { TMyComponent }

  TMyComponent = class(TComponent)
  private
+    FMyBoolean: Boolean;
+    FMyCollection: TCollection;
    FMyDouble: Double;
    FMyEnum: TMyEnum;
    FMyInteger: integer;
    FMySet: TMySet;
+    FMySingle: Single;
    FMyString: string;
    FMyWideString: widestring;
  public
+    constructor Create(TheOwner: TComponent); override;
+  published
    property MyDouble: Double read FMyDouble write FMyDouble;
+    property MySingle: Single read FMySingle write FMySingle;
    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;
-    
+    property MyBoolean: Boolean read FMyBoolean write FMyBoolean;
+    property MyCollection: TCollection read FMyCollection write FMyCollection;
  end;


@ -37,12 +53,15 @@ type

  TStreamAsXMLForm = class(TForm)
    Button1: TButton;
+    Button2: TButton;
    GroupBox1: TGroupBox;
+    GroupBox2: TGroupBox;
    procedure FormCreate(Sender: TObject);
  private
    FFilename: string;
    procedure SetFilename(const AValue: string);
  public
+    MyComponent: TMyComponent;
    procedure StreamComponents;
    property Filename: string read FFilename write SetFilename;
  end; 
@ -91,19 +110,17 @@ end;

 procedure TStreamAsXMLForm.FormCreate(Sender: TObject);
 var
-  MyComponent: TMyComponent;
+  MySubComponent: 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;
+  MySubComponent:=TMyComponent.Create(MyComponent);
+  with MySubComponent do begin
+    Name:='MySubComponent';
  end;

  StreamComponents;
@ -123,7 +140,9 @@ begin
  DebugLn('TStreamAsXMLForm.StreamComponents ',Filename);
  XMLConfig:=TXMLConfig.Create(Filename);
  try
-    WriteComponentToXMLConfig(XMLConfig,'Component',GroupBox1);
+    WriteComponentToXMLConfig(XMLConfig,'Component',Self);
+    //WriteComponentToXMLConfig(XMLConfig,'Component',MyComponent);
+    //WriteComponentToXMLConfig(XMLConfig,'Component',GroupBox1);
    XMLConfig.Flush;
  finally
    XMLConfig.Free;
@ -135,6 +154,25 @@ begin
  sl.Free;
 end;

+{ TMyComponent }
+
+constructor TMyComponent.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  MyDouble:=-1.23456789;
+  MySingle:=-1.98765432;
+  MyEnum:=myEnum2;
+  MySet:=[myEnum1,myEnum3];
+  MyString:='Some text as string';
+  MyWideString:='Some text as widestring';
+  MyInteger:=1234;
+  MyBoolean:=true;
+  MyCollection:=TCollection.Create(TMyCollectionItem);
+  TMyCollectionItem(MyCollection.Add).MyString:='First';
+  TMyCollectionItem(MyCollection.Add).MyString:='Second';
+  TMyCollectionItem(MyCollection.Add).MyString:='Third';
+end;
+
 initialization
  {$I mainunit.lrs}