XML streaming: implemented reading child controls

git-svn-id: trunk@9163 -
2025-08-24 00:49:45 +02:00 · 2006-04-23 11:03:05 +00:00 · 2006-04-23 11:03:05 +00:00 · baa2ccb6bc
commit baa2ccb6bc
parent a6dce8e43a
4 changed files with 153 additions and 54 deletions
--- a/components/codetools/laz_xmlstreaming.pas
+++ b/components/codetools/laz_xmlstreaming.pas
@ -420,12 +420,12 @@ function TXMLObjectReader.ReadNextValue(Stay: Boolean): TValueType;

  procedure RaiseUnknownNode(Node: TDOMNode);
  begin
-    raise EReadError.Create('TXMLObjectReader: unknown node '+Node.NodeName);
+    raise EReadError.Create('TXMLObjectReader: unknown node "'+Node.NodeName+'"');
  end;

  procedure RaiseUnknownParentNode(Node: TDOMNode);
  begin
-    raise EReadError.Create('TXMLObjectReader: unknown parent node '+Node.NodeName);
+    raise EReadError.Create('TXMLObjectReader: unknown parent node "'+Node.NodeName+'" Element="'+FElement.NodeName+'"');
  end;
  
  procedure RaiseInvalidElementPosition;
@ -435,7 +435,36 @@ function TXMLObjectReader.ReadNextValue(Stay: Boolean): TValueType;
  
  procedure RaiseNodeNotFound(const NodeName: string);
  begin
-    raise EReadError.Create('TXMLObjectReader: invalid Node='+FElement.NodeName);
+    raise EReadError.Create('TXMLObjectReader: expected "'+NodeName+'", but found "'+FElement.NodeName+'"');
+  end;
+  
+  procedure CheckNode(const NodeName: string);
+  begin
+    if FElement.NodeName<>NodeName then
+      RaiseNodeNotFound(NodeName);
+  end;
+  
+  procedure GoToNextComponent;
+  begin
+    FElement:=FElement.ParentNode as TDOMElement;
+    CheckNode('component');
+    FElementPosition:=0;
+    if FElement.NextSibling is TDOMElement then begin
+      // go to next component
+      writeln('TXMLObjectReader.ReadNextValue properties: next component');
+      FElement:=TDOMElement(FElement.NextSibling);
+      CheckNode('component');
+    end else begin
+      // end of children list
+      if FElement.ParentNode.NodeName='children' then begin
+        writeln('TXMLObjectReader.ReadNextValue end of children list');
+        FElement:=FElement.ParentNode as TDOMElement;
+        FElementPosition:=1;
+      end else begin
+        writeln('TXMLObjectReader.ReadNextValue END reading');
+        FElement:=nil;
+      end;
+    end;
  end;

 var
@ -443,10 +472,49 @@ var
  CurInt64: Int64;
 begin
  writeln('TXMLObjectReader.ReadNextValue Stay=',Stay,' Element=',FElement.NodeName,' Pos=',FElementPosition);
-  if FElement.NodeName='properties' then begin
-    // FElement is at end of property list
+  
+  if FElement.NodeName='component' then begin
+    writeln('TXMLObjectReader.ReadNextValue is start of component');
+    Result:=vaString;
+    if not Stay then begin
+      // here a BeginComponent shoud be called, not ReadValue
+      RaiseUnknownNode(FElement);
+    end;
+  end
+  else if FElement.NodeName='properties' then begin
+    // FElement is at end of property list or non existing children list
+    // 0: end of property list
+    // 1: end of non existing children list
    writeln('TXMLObjectReader.ReadNextValue FElement is at end of property list');
    Result:=vaNull;
+    if not Stay then begin
+      if FElement.NextSibling is TDOMElement then begin
+        // leave properties and go to first child component
+        writeln('TXMLObjectReader.ReadNextValue properties: children');
+        FElement:=TDOMElement(FElement.NextSibling);
+        FElementPosition:=0;
+        CheckNode('children');
+        if not (FElement.FirstChild is TDOMElement) then
+          RaiseUnknownNode(FElement);
+        FElement:=TDOMElement(FElement.FirstChild);
+      end else begin
+        // there is no children list behind the properties -> simulate it
+        if FElementPosition=0 then begin
+          inc(FElementPosition);
+        end else begin
+          // children has been simulated -> now go to next component
+          GoToNextComponent;
+        end;
+      end;
+    end;
+  end
+  else if FElement.NodeName='children' then begin
+    // end of children list
+    writeln('TXMLObjectReader.ReadNextValue End of children list');
+    Result:=vaNull;
+    if not Stay then begin
+      GoToNextComponent;
+    end;
  end
  else if FElement.NodeName='list' then begin
    // FElement is a list element
@ -555,13 +623,11 @@ begin
            begin
              // go to node 'collection'
              FElement:=FElement.FirstChild as TDOMElement;
-              if FElement.NodeName<>'collection' then
-                RaiseNodeNotFound('collection');
+              CheckNode('collection');
              FElementPosition:=0;
              // go to node 'list'
              FElement:=FElement.FirstChild as TDOMElement;
-              if FElement.NodeName<>'list' then
-                RaiseNodeNotFound('list');
+              CheckNode('list');
            end;
          end;
        end;
@ -704,7 +770,10 @@ var
 begin
  writeln('TXMLObjectReader.BeginComponent START');
  
-  ComponentNode:=FElement.FindNode('component');
+  if FElement.NodeName='component' then
+    ComponentNode:=FElement
+  else
+    ComponentNode:=FElement.FindNode('component');
  if ComponentNode=nil then
    raise Exception.Create('component node not found');
  if not (ComponentNode is TDOMElement) then
--- a/examples/xmlstreaming/mainunit.lfm
+++ b/examples/xmlstreaming/mainunit.lfm
@ -13,50 +13,41 @@ object StreamAsXMLForm: TStreamAsXMLForm
  Width = 493
  object SourceGroupBox: TGroupBox
    Caption = 'SourceGroupBox'
-    ClientHeight = 133
-    ClientWidth = 271
+    ClientHeight = 173
+    ClientWidth = 465
    TabOrder = 0
    Left = 16
-    Height = 150
+    Height = 190
    Top = 16
-    Width = 275
+    Width = 469
    object Button1: TButton
      BorderSpacing.InnerBorder = 2
      Caption = 'Button1'
      TabOrder = 0
-      Left = 33
+      Left = 12
      Height = 25
-      Top = 15
+      Top = 14
      Width = 75
    end
-    object GroupBox2: TGroupBox
-      Caption = 'GroupBox2'
-      ClientHeight = 80
-      ClientWidth = 128
+    object DemoGroupBox: TGroupBox
+      Caption = 'DemoGroupBox'
+      ClientHeight = 150
+      ClientWidth = 353
      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
+      Left = 97
+      Height = 167
+      Top = -1
+      Width = 357
    end
  end
  object DestinationGroupBox: TGroupBox
    Caption = 'DestinationGroupBox'
-    ClientHeight = 143
-    ClientWidth = 267
+    ClientHeight = 203
+    ClientWidth = 467
    TabOrder = 1
-    Left = 20
-    Height = 160
+    Left = 16
+    Height = 220
    Top = 210
-    Width = 271
+    Width = 471
  end
 end
--- a/examples/xmlstreaming/mainunit.lrs
+++ b/examples/xmlstreaming/mainunit.lrs
@ -1,19 +1,19 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TStreamAsXMLForm','FORMDATA',[
  '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'#14'SourceGroupBox'#7'Capti'
-  +'on'#6#14'SourceGroupBox'#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'Button1'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7'Button'
-  +'1'#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#9'TGroupBox'#19'DestinationGroupBox'#7'Caption'#6
-  +#19'DestinationGroupBox'#12'ClientHeight'#3#143#0#11'ClientWidth'#3#11#1#8'T'
-  +'abOrder'#2#1#4'Left'#2#20#6'Height'#3#160#0#3'Top'#3#210#0#5'Width'#3#15#1#0
-  +#0#0
+  +'on'#6#14'SourceGroupBox'#12'ClientHeight'#3#173#0#11'ClientWidth'#3#209#1#8
+  +'TabOrder'#2#0#4'Left'#2#16#6'Height'#3#190#0#3'Top'#2#16#5'Width'#3#213#1#0
+  +#7'TButton'#7'Button1'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#7'Butt'
+  +'on1'#8'TabOrder'#2#0#4'Left'#2#12#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#0
+  +#0#9'TGroupBox'#12'DemoGroupBox'#7'Caption'#6#12'DemoGroupBox'#12'ClientHeig'
+  +'ht'#3#150#0#11'ClientWidth'#3'a'#1#8'TabOrder'#2#1#4'Left'#2'a'#6'Height'#3
+  +#167#0#3'Top'#2#255#5'Width'#3'e'#1#0#0#0#9'TGroupBox'#19'DestinationGroupBo'
+  +'x'#7'Caption'#6#19'DestinationGroupBox'#12'ClientHeight'#3#203#0#11'ClientW'
+  +'idth'#3#211#1#8'TabOrder'#2#1#4'Left'#2#16#6'Height'#3#220#0#3'Top'#3#210#0
+  +#5'Width'#3#215#1#0#0#0
 ]);
--- a/examples/xmlstreaming/mainunit.pas
+++ b/examples/xmlstreaming/mainunit.pas
@ -56,9 +56,8 @@ type

  TStreamAsXMLForm = class(TForm)
    Button1: TButton;
-    Button2: TButton;
    SourceGroupBox: TGroupBox;
-    GroupBox2: TGroupBox;
+    DemoGroupBox: TGroupBox;
    DestinationGroupBox: TGroupBox;
    procedure FormCreate(Sender: TObject);
  private
@ -155,6 +154,7 @@ begin
  DestroyDriver:=false;
  try
    Reader:=CreateXMLReader(XMLConfig.Document,Path,DestroyDriver);
+    Reader.OnFindComponentClass:=OnFindComponentClass;

    // get root class
    AClassName:=(Reader.Driver as TXMLObjectReader).GetRootClassName(IsInherited);
@ -194,6 +194,8 @@ end;
 procedure TStreamAsXMLForm.FormCreate(Sender: TObject);
 var
  MySubComponent: TMyComponent;
+  DemoGroupBox_1: TGroupBox;
+  DemoGroupBox_2: TGroupBox;
 begin
  Filename:='test.xml';

@ -205,6 +207,40 @@ begin
  with MySubComponent do begin
    Name:='MySubComponent';
  end;
+  
+  // create nested controls
+  DemoGroupBox_1:=TGroupBox.Create(DemoGroupBox);
+  with DemoGroupBox_1 do begin
+    Name:='DemoGroupBox_1';
+    Parent:=DemoGroupBox;
+    SetBounds(5,5,150,150);
+    with TButton.Create(DemoGroupBox) do begin
+      Name:='Button1';
+      Parent:=DemoGroupBox_1;
+      SetBounds(10,20,80,30);
+    end;
+    with TButton.Create(DemoGroupBox) do begin
+      Name:='Button2';
+      Parent:=DemoGroupBox_1;
+      SetBounds(10,60,80,20);
+    end;
+  end;
+  DemoGroupBox_2:=TGroupBox.Create(DemoGroupBox);
+  with DemoGroupBox_2 do begin
+    Name:='DemoGroupBox_2';
+    Parent:=DemoGroupBox;
+    SetBounds(155,5,150,150);
+    with TButton.Create(DemoGroupBox) do begin
+      Name:='Button3';
+      Parent:=DemoGroupBox_2;
+      SetBounds(10,20,80,30);
+    end;
+    with TButton.Create(DemoGroupBox) do begin
+      Name:='Button4';
+      Parent:=DemoGroupBox_2;
+      SetBounds(10,60,80,20);
+    end;
+  end;

  WriteComponents;
  ReadComponents;
@ -225,8 +261,8 @@ begin
  XMLConfig:=TXMLConfig.Create(Filename);
  try
    //WriteComponentToXMLConfig(XMLConfig,'Component',Self);
-    WriteComponentToXMLConfig(XMLConfig,'Component',MyComponent);
-    //WriteComponentToXMLConfig(XMLConfig,'Component',GroupBox2);
+    //WriteComponentToXMLConfig(XMLConfig,'Component',MyComponent);
+    WriteComponentToXMLConfig(XMLConfig,'Component',DemoGroupBox);
    XMLConfig.Flush;
  finally
    XMLConfig.Free;
@ -252,6 +288,8 @@ begin
      @OnFindComponentClass,DestinationGroupBox);
    if NewComponent is TMyComponent then
      TMyComponent(NewComponent).WriteDebugReport;
+    if NewComponent is TControl then
+      TControl(NewComponent).Parent:=DestinationGroupBox;
    XMLConfig.Flush;
  finally
    XMLConfig.Free;
@ -272,6 +310,7 @@ begin
    ComponentClass:=TButton
  else if CompareText(AClassName,'TMyComponent')=0 then
    ComponentClass:=TMyComponent;
+  DebugLn('TStreamAsXMLForm.OnFindComponentClass ',AClassName,' ',dbgs(ComponentClass));
 end;

 { TMyComponent }