main.~pas

此程序演示了利用xml控件（当然也可以不通过xml控件）

    1: FFocusedNode.AttributeValue[Index] := FFocusedNode.FromWidestring(NewText);
    end;//case
  end else begin
    ANode := FFocusedNode.Nodes[Index];
    case Column of
    0: ANode.Name := NewText;
    1: ANode.ValueAsWidestring := NewText;
    end;//case
  end;
end;

function TfrmMain.MultiAttrCount(ANode: TXmlNode): integer;
// Count the attributes, but if acSingleNodeAsAttrib is checked we also add
// the single nodes
var
  i: integer;
begin
  Result := 0;
  if not assigned(ANode) then exit;
  Result := ANode.AttributeCount;
  if acSingleNodeAsAttrib.Checked then
    for i := 0 to ANode.NodeCount - 1 do
      if IsSingleNode(ANode[i]) then
        inc(Result);
end;

function TfrmMain.MultiNodeByIndex(ANode: TXmlNode;
  AIndex: integer): TXmlNode;
// Return the child node of ANode at AIndex, taking into account the setting for
// acHideSingleNodes
var
  i: integer;
begin
  Result := nil;
  if assigned(ANode) then with ANode do begin
    if acHideSingleNodes.Checked then begin
      for i := 0 to NodeCount - 1 do
        if not IsSingleNode(Nodes[i]) then begin
          dec(AIndex);
          if AIndex < 0 then begin
            Result := Nodes[i];
            exit;
          end;
        end;
    end else
      Result := Nodes[AIndex];
  end;
end;

function TfrmMain.MultiNodeCount(ANode: TXmlNode): integer;
// Count the number of nodes, taking into account the setting for acHideSingleNodes
var
  i: integer;
begin
  Result := 0;
  if assigned(ANode) then with ANode do begin
    if acHideSingleNodes.Checked then begin
      for i := 0 to NodeCount - 1 do
        if not IsSingleNode(Nodes[i]) then
          inc(Result)
    end else
      Result := NodeCount;
  end;
end;

function TfrmMain.NiceString(const Value: string): string;
begin
  if acReadableNames.Checked then begin
  Result := Lowercase(Value);
  if (length(Value) > 0) and (Result[1] in ['a'..'z']) then
    Result[1] := UpCase(Result[1]);
  end else
    Result := Value;
end;

procedure TfrmMain.pcTreeChange(Sender: TObject);
var
  OldFormat: TXmlFormatType;
begin
  if (pcTree.ActivePage = tsXmlSource) then begin
    // Show our Xml Document in readable format
    Oldformat := FXmlDoc.XmlFormat;
    try
      FXmlDoc.XmlFormat := xfReadable;
      if FXmlDoc.IsEmpty then
        mmXmlSource.Text := ''
      else
        mmXMLSource.Text := FXmlDoc.WriteToString;
    finally
      FXmlDoc.XmlFormat := OldFormat;
    end;
  end;
end;

procedure TfrmMain.stXmlTreeChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
// Use this event to display related info in other panes
var
  FData: PNodeRec;
begin
  // Signal the setup that the current tag changed
  FData := Sender.GetNodeData(Node);
  if assigned(FData) then
    FFocusedNode := FData^.FNode
  else
    FFocusedNode := nil;
  RegenerateProperties;
end;

procedure TfrmMain.stXmlTreeEditing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := true;
end;

procedure TfrmMain.stXmlTreeNewText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
  FData: PNodeRec;
begin
  FData := Sender.GetNodeData(Node);
  case Column of
  0: FData.FNode.Name := NewText;
  1: FData.FNode.ValueAsWidestring := NewText;
  end;//case
end;

procedure TfrmMain.stXmlTreeExpanding(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var Allowed: Boolean);
var
  FData: PNodeRec;
begin
  with stXMLTree do begin
    ChildCount[Node] := 0;
    FData := Sender.GetNodeData(Node);
    if assigned(FData^.FNode) then
      ChildCount[Node] := MultiNodeCount(FData^.FNode);
    InvalidateToBottom(Node);
  end;
end;

procedure TfrmMain.stXmlTreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
// Get the data for this tree node
var
  FData: PNodeRec;
begin
  FData := Sender.GetNodeData(Node);
  if assigned(FData^.FNode) then begin
    Case Column of
    0: CellText := NiceString(FData^.FNode.Name);
    // As can be seen here, both XmlDocuments as TVirtualTreeview support
    // widestring, so you can view your differently-encoded XML documents correctly
    1: CellText := FData^.FNode.ValueAsWideString;
    end;
  end;
end;

procedure TfrmMain.stXmlTreeInitNode(Sender: TBaseVirtualTree; ParentNode,
  Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
// Initialize the tree node; assign its corresponding Xml node and tell it if it
// has any children yes or no
var
  FData, FParentData: PNodeRec;
  FParentNode: TXmlNode;
begin
  if ParentNode = nil then begin
    // Root node
    if assigned(FXmlDoc) then begin
      FData := Sender.GetNodeData(Node);
      FData^.FNode := FXmlDoc.RootNodeList.Nodes[Node.Index];
      InitialStates := [];
      if assigned(FData^.FNode) then begin
        FData^.FNode.Tag := integer(Node);
        // initial states
        if MultiNodeCount(FData^.FNode) > 0 then
          InitialStates := [ivsHasChildren];
      end;
    end;

  end else begin

    // We need to use the parent node
    FParentData := Sender.GetNodeData(ParentNode);
    FParentNode := FParentData.FNode;

    // Find the new node
    FData := Sender.GetNodeData(Node);
    if integer(Node.Index) < FParentNode.NodeCount then begin
      FData^.FNode := MultiNodeByIndex(FParentNode, Node.Index);
      InitialStates := [];
      if assigned(FData^.FNode) then begin
        FData^.FNode.Tag := integer(Node);
        // initial states
        if MultiNodeCount(FData^.FNode) > 0 then
          InitialStates := [ivsHasChildren];
      end;
    end;

  end;
end;

procedure TfrmMain.stXmlTreeGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
var
  FData: PNodeRec;
  ANode: TXmlNode;
begin
  // The image belonging to the treenode
  ImageIndex := -1;
  if Kind in [ikNormal, ikSelected] then
    if Column = 0 then begin
      FData := Sender.GetNodeData(Node);
      if assigned(FData) then begin
        ANode := FData.FNode;
        if assigned(ANode) then
          ImageIndex := ElementTypeToImageIndex(ANode.ElementType);
      end;
    end;
end;

procedure TfrmMain.Regenerate;
// Regenerate all screen elements, rebuilds the treeview
begin
  // Redraw XML tree
  stXmlTree.Clear;
  stXmlTree.RootNodeCount := FXmlDoc.RootNodeList.NodeCount;
  // Properties pane
  RegenerateProperties;
  // Form caption
  if Length(FFileName) > 0 then
    Caption := Format('%s %s [%s]', [cFormHeader, cAppVersion, FFilename])
  else
    Caption := Format('%s %s - No file selected', [cFormHeader, cAppVersion]);
  // Update menu enabled/checked states
  UpdateMenu;
end;

procedure TfrmMain.RegenerateFromNode(ANode: TXmlNode);
var
  TreeNode: PVirtualNode;
begin
  if not assigned(ANode) then begin
    Regenerate;
    exit;
  end;
  TreeNode := pointer(ANode.Tag);
  if not assigned(TreeNode) then begin
    Regenerate;
    exit;
  end;
  stXmlTree.ResetNode(TreeNode);
  stXmlTree.Expanded[TreeNode] := True;
end;

procedure TfrmMain.RegenerateProperties;
// Invalidate the properties listview
begin
  stAttributes.Clear;
  stAttributes.RootNodeCount := MultiAttrCount(FFocusedNode);
end;

procedure TfrmMain.UpdateMenu;
begin
  BeginUpdate;
  try
    acOutputReadable.Checked := FXmlDoc.XmlFormat = xfReadable;
  finally
     EndUpdate;
  end;
end;

procedure TfrmMain.XmlUnicodeLoss(Sender: TObject);
// The TXmlDocument event OnUnicodeLoss was called. This means some characters in the
// XML document cannot be converted to ANSI and may lead to a loss if saved to the
// same file.
begin
  MessageDlg(
    'WARNING: Some characters in this unicode XML document cannot be converted to the'#13 +
    'internal Ansi representation. Do NOT save the XML document under the same name if you'#13 +
    'want to preserve the original unicode characters.', mtWarning, [mbOK], 0);
end;

procedure TfrmMain.stXmlTreeKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
  VK_DELETE:
    // User pressed DEL
    acElementDeleteExecute(nil);
  end;//case
end;

procedure TfrmMain.acFileExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.acElementDeleteExecute(Sender: TObject);
// Delete the focused element
var
  AParent: TXmlNode;
begin
  if assigned(FFocusedNode) and (FFocusedNode <> FXmlDoc.Root) then begin
    AParent := FFocusedNode.Parent;
    FFocusedNode.Delete;
    FFocusedNode := nil;
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.acElementInsertBeforeExecute(Sender: TObject);
var
  AParent, ANode: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  AParent := FFocusedNode.Parent;
  if AParent = FXmlDoc.RootNodeList then begin
    ShowMessage(sCannotInsertRootElement);
    exit;
  end;
  if assigned(AParent) then begin
    ANode := TXmlNode.Create(FXmlDoc);
    ANode.Name := 'element';
    AParent.NodeInsert(AParent.NodeIndexOf(FFocusedNode), ANode);
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.acElementInsertAfterExecute(Sender: TObject);
var
  AParent, ANode: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  AParent := FFocusedNode.Parent;
  if AParent = FXmlDoc.RootNodeList then begin
    ShowMessage(sCannotInsertRootElement);
    exit;
  end;
  if assigned(AParent) then begin
    ANode := TXmlNode.Create(FXmlDoc);
    ANode.Name := 'element';
    AParent.NodeInsert(AParent.NodeIndexOf(FFocusedNode) + 1, ANode);
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.acElementInsertSubExecute(Sender: TObject);
var
  AParent, ANode: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  ANode := TXmlNode.Create(FXmlDoc);
  ANode.Name := 'element';
  FFocusedNode.NodeInsert(0, ANode);
  RegenerateFromNode(FFocusedNode);
end;

procedure TfrmMain.acCommentInsertExecute(Sender: TObject);
var
  AParent, ANode: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  AParent := FFocusedNode.Parent;
  if assigned(AParent) then begin
    ANode := TXmlNode.Create(FXmlDoc);
    ANode.ElementType := xeComment;
    ANode.Name := 'comment';
    AParent.NodeInsert(AParent.NodeIndexOf(FFocusedNode), ANode);
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.acElementUpExecute(Sender: TObject);
var
  Idx: integer;
  AParent: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  AParent := FFocusedNode.Parent;
  if assigned(AParent) then begin
    Idx := AParent.NodeIndexOf(FFocusedNode);
    if Idx > 0 then
      AParent.NodeExchange(Idx - 1, Idx);
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.acElementDownExecute(Sender: TObject);
var
  Idx: integer;
  AParent: TXmlNode;
begin
  if not assigned(FFocusedNode) then exit;
  AParent := FFocusedNode.Parent;
  if assigned(AParent) then begin
    Idx := AParent.NodeIndexOf(FFocusedNode);
    if Idx < AParent.NodeCount - 1 then
      AParent.NodeExchange(Idx, Idx + 1);
    RegenerateFromNode(AParent);
  end;
end;

procedure TfrmMain.stAttributesChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
  IsAttribute: boolean;
  Index: integer;
begin
  if not assigned(Node) then begin
    FFocusedAttributeIndex := -1;
    exit;
  end;
  GetPropertyInfo(Node, IsAttribute, Index);
  if IsAttribute then
    FFocusedAttributeIndex := Index
  else
    FFocusedAttributeIndex := -1;
end;

procedure TfrmMain.stAttributesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
  VK_DELETE:
    // User pressed DEL
    acAttributeDeleteExecute(nil);
  end;//case
end;

procedure TfrmMain.acAttributeAddExecute(Sender: TObject);
begin
  if assigned(FFocusedNode) then
    FFocusedNode.AttributeAdd('attribute', '');
  RegenerateProperties;
end;

procedure TfrmMain.acAttributeDeleteExecute(Sender: TObject);
begin
  if assigned(FFocusedNode) and (FFocusedAttributeIndex >= 0) then
    FFocusedNode.AttributeDelete(FFocusedAttributeIndex);
  RegenerateProperties;
end;

procedure TfrmMain.acAttributeUpExecute(Sender: TObject);
begin
  if assigned(FFocusedNode) and (FFocusedAttributeIndex > 0) then
    FFocusedNode.AttributeExchange(FFocusedAttributeIndex - 1, FFocusedAttributeIndex);
  RegenerateProperties;
end;

procedure TfrmMain.acAttributeDownExecute(Sender: TObject);
begin
  if assigned(FFocusedNode) and (FFocusedAttributeIndex < FFocusedNode.AttributeCount - 1) then
    FFocusedNode.AttributeExchange(FFocusedAttributeIndex, FFocusedAttributeIndex + 1);
  RegenerateProperties;
end;

end.