2004. április 3., szombat

Writing all controls of given component to TXMLDocument


Problem/Question/Abstract:

Down all controls for component in XMLDocument in simplest way?

Answer:

Simply it seems to pass under the component list and to create appropriate nodes of the XML-document:

for k := 0 to MyComponent.ComponentCount - 1 do
begin
  if not (MyComponent.Components[k] is TControl) then
    Continue;
  // Here create node of the XML-document
end;

However the problem is to satisfy parent - child relations during creation of nodes of the XML-document.
The procedure given below carries out this task by conducting special list of those controls for which are already created XML-document nodes.
Controls corresponding to created nodes are excluded from process of iteration.

// Writing all controls of given component to TXMLDocument according parent-child relations

procedure Get_Component_as_XML(AXMLDoc: TXMLDocument; AComponent: TComponent);
var
  k: Integer;
  Ctrl: TControl;
  List: TList;
  XMLNode: IXMLNode;
  GrCtrl: TGraphicControl;

  procedure Add_WinControlAttributes(AWCtrl: TWinControl; AXMLNode: IXMLNode);
  begin
    with AXMLNode do
    begin
      Attributes['Name'] := AWCtrl.Name;
      Attributes['Owner'] := AWCtrl.Owner.Name;
      Attributes['Left'] := IntToStr(AWCtrl.Left);
      Attributes['Top'] := IntToStr(AWCtrl.Top);
      Attributes['Width'] := IntToStr(AWCtrl.Width);
      Attributes['Height'] := IntToStr(AWCtrl.Height);
      // ... add all needed properties
    end;
  end;

  procedure Add_GraphicsControlAttributes(AGCtrl: TGraphicControl; AXMLNode:
    IXMLNode);
  begin
    with AXMLNode do
    begin
      Attributes['Name'] := AGCtrl.Name;
      Attributes['Owner'] := AGCtrl.Owner.Name;
      Attributes['Left'] := AGCtrl.Left;
      Attributes['Top'] := IntToStr(AGCtrl.Top);
      Attributes['Width'] := IntToStr(AGCtrl.Width);
      Attributes['Height'] := IntToStr(AGCtrl.Height);
      // ... add all needed properties
    end;
  end;

  procedure Add_XML_Node(AWCtrl: TWinControl; AXMLNode: IXMLNode);
  var
    i: Integer;
    WinC: TWinControl;
    SubIXMLNode,
      NewStock: IXMLNode;
    SubCtrl: TControl;
    SubGrCtrl: TGraphicControl;
  begin
    NewStock := AXMLNode.AddChild(AWCtrl.ClassName);
    Add_WinControlAttributes(AWCtrl, NewStock);

    if AWCtrl.ControlCount > 0 then
      for i := 0 to AWCtrl.ControlCount - 1 do
      begin
        SubCtrl := TControl(AWCtrl.Controls[i]);
        if List.IndexOf(SubCtrl) >= 0 then
          Continue;

        // take a special look at this list
        List.Add(Pointer(SubCtrl));

        if SubCtrl is TGraphicControl then
        begin
          SubGrCtrl := TGraphicControl(SubCtrl);
          SubIXMLNode := NewStock.AddChild(SubGrCtrl.ClassName);
          Add_GraphicsControlAttributes(SubGrCtrl, SubIXMLNode);
        end

        else if SubCtrl is TWinControl then
        begin
          WinC := TWinControl(SubCtrl);
          Add_XML_Node(WinC, NewStock);
        end;
      end;
  end;

begin
  AXMLDoc.XML.Clear;
  AXMLDoc.XML.Add(Format('<%s>', [AComponent.Name]));
  AXMLDoc.XML.Add(Format('</%s>', [AComponent.Name]));

  AXMLDoc.Active := True;

  List := TList.Create; // special list to hold controls added to XML
  try
    for k := 0 to AComponent.ComponentCount - 1 do
    begin
      if not (AComponent.Components[k] is TControl) then
        Continue;
      Ctrl := TControl(AComponent.Components[k]);
      if List.IndexOf(Ctrl) >= 0 then
        Continue;

      // take a special look at this list
      List.Add(Pointer(Ctrl));

      if Ctrl is TGraphicControl then
      begin
        GrCtrl := TGraphicControl(Ctrl);
        XMLNode := AXMLDoc.DocumentElement.AddChild(GrCtrl.ClassName);
        Add_GraphicsControlAttributes(GrCtrl, XMLNode);
      end

      else if Ctrl is TWinControl then
        // Recursive process for child controls
        Add_XML_Node(TWinControl(Ctrl), AXMLDoc.DocumentElement);
    end;
  finally
    List.Clear;
    List.Free;
  end;
end;

I do not apply for exclusive novelty, but it seems, that this procedure may be useful to someone.

Nincsenek megjegyzések:

Megjegyzés küldése