main.pas

是一个delphi的流程制作软件

unit Main;

{ Copyright (c) 2000 by Charlie Calvert

  Feel free to use this code in your own programs. I just don't want you to
  write books or articles based on this code.
  
  Example of using MS XML parser. Toggle BreakOutAttributes on Line 144.

  You need to download install the parser to use the program as explained
  in accompanying article from http://www.elvenware.com. }

interface

uses
  Windows, Messages, SysUtils,
  Classes, Graphics, Controls,
  Forms, Dialogs, Menus,
  StdCtrls, ExtCtrls, ComCtrls,
  OleServer, MSXML_TLB;

type
  TElementNodeEvent = procedure(Sender: TObject; Level: Integer; Value: string) of object;
  TAnyNodeEvent = procedure(Sender: TObject; Value: string) of object;

  TCSCXMLParseMS = class
  private
    FBreakoutAttributes: Boolean;
    FElementNodeEvent: TElementNodeEvent;
    FAnyNodeEvent: TAnyNodeEvent;
    function OutputContent(const toWrite: String; doEscapes: Boolean): string;
    procedure WriteIt(toWrite: IXMLDOMNode; Level: Integer);
    function GetElementNodeEvent: TElementNodeEvent;
    procedure SetElementNodeEvent(const Value: TElementNodeEvent);
    procedure SetAnyNodeEvent(const Value: TAnyNodeEvent);
  public
    procedure WriteDom(toWrite: IXMLDOMNode);
    property OnAnyNode: TAnyNodeEvent
      read FAnyNodeEvent
      write SetAnyNodeEvent;
    property BreakoutAttributes: boolean
      read FBreakoutAttributes
      write FBreakoutAttributes;
    property OnElementNode: TElementNodeEvent
      read GetElementNodeEvent
      write SetElementNodeEvent;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Run1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Splitter1: TSplitter;
    OpenDialog1: TOpenDialog;
    TreeView1: TTreeView;
    Options1: TMenuItem;
    DOMDocument1: TDOMDocument;
    ExpandAll1: TMenuItem;
    CollapseTree1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure Run1Click(Sender: TObject);
    procedure ExpandAll1Click(Sender: TObject);
    procedure CollapseTree1Click(Sender: TObject);
  private
    { Private declarations }
    FNode: TTreeNode;
    procedure AddToTree(Sender: TObject; Level: Integer; Value: string);
    procedure AddToMemo(Sender: TObject; Value: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function GetStartDir: string;
begin
  Result := ExtractFilePath(ParamStr(0));
  if Result[Length(Result)] <> '\' then
    Result := Result + '\';
end;

procedure TForm1.AddToMemo(Sender: TObject; Value: string);
begin
  Memo1.Lines.Add(Value);
end;

procedure TForm1.AddToTree(Sender: TObject; Level: Integer; Value: string);
var
  Node: TTreeNode;
  i: Integer;
begin
  case Level of
    0: FNode := TreeView1.Items.Add(nil, Value);
    1: FNode.Owner.AddChild(FNode, Value);
    2: FNode.Owner.AddChild(FNode, Value);
    3: begin
       Node := FNode.GetLastChild;
       Node.Owner.AddChild(Node, Value);
    end;
    else begin
       Node := FNode.GetLastChild;
       for i := 4 to Level do
         Node := Node.GetLastChild;
       Node.Owner.AddChild(Node, Value);
    end;
  end;
end;

procedure TForm1.CollapseTree1Click(Sender: TObject);
begin
  TreeView1.FullCollapse;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.ExpandAll1Click(Sender: TObject);
begin
  TreeView1.FullExpand;
end;

procedure TForm1.Run1Click(Sender: TObject);
var
  Parse: TCSCXMLParseMS;
begin
  OpenDialog1.InitialDir := GetStartDir;
  if OpenDialog1.Execute then begin
    Memo1.Clear;
    TreeView1.Items.Clear;
    DomDocument1.Load(OpenDialog1.FileName);
    AddToTree(Self, 0, 'Doc');
    Parse := TCSCXMLParseMS.Create;
    // Toggle BreakoutAttributes
    Parse.BreakoutAttributes := True;
    Parse.OnElementNode := AddToTree;
    Parse.OnAnyNode := AddToMemo;
    Parse.WriteIt(DomDocument1.DocumentElement, 0);
    parse.Free;
  end;
end;

{ ------------------------------------ }
{ -- TCSCXMLMSParse ------------------ }
{ ------------------------------------ }

function TCSCXMLParseMS.GetElementNodeEvent: TElementNodeEvent;
begin
  Result := FElementNodeEvent;
end;

function TCSCXMLParseMS.OutputContent(const toWrite: String; doEscapes: Boolean): string;
var
  Length: Integer;
//  Chars: array[0..2500] of Char;
  Index: Integer;
  Temp: string;
begin
  if (doEscapes = false) then begin
    if Assigned(FAnyNodeEvent) then
      FAnyNodeEvent(Self, toWrite);
    Result := toWrite;
  end else begin
      length := System.length(toWrite);

      Temp := '';

      for index := 1 to Length do begin
        case (toWrite[index]) of
          '&': Temp := Temp + '&amp;';
          '<': Temp := Temp + '&lt;';
          '>': Temp := Temp + '&gt;';
          '"': Temp := Temp + '&quot;';
          #9 : Temp := Temp + 'Tab';
          #10: Temp := Temp + 'Linefeed: #10';
          #13: Temp := Temp + 'LineFeed: #13';
          #19: Temp := Temp + '#19'
        else
          // If it is none of the special characters, print it as such
          // target << StrX(&chars[index], 1);
          Temp := Temp + toWrite[index];
        end;
        if Assigned(FAnyNodeEvent) then
          FAnyNodeEvent(Self, Temp);
        Result := Temp;
    end;
  end;
end;

procedure TCSCXMLParseMS.SetAnyNodeEvent(const Value: TAnyNodeEvent);
begin
  FAnyNodeEvent := Value;
end;

procedure TCSCXMLParseMS.SetElementNodeEvent(const Value: TElementNodeEvent);
begin
  FElementNodeEvent := Value;
end;

procedure TCSCXMLParseMS.WriteDom(toWrite: IXMLDOMNode);
begin
  WriteIt(toWrite, 0);
end;

// ---------------------------------------------------------------------------
//
//  ostream << DOM_Node
//
//                Stream out a DOM node, and, recursively, all of its children.
//                This function is the heart of writing a DOM tree out as
//                XML source.  Give it a document node and it will do the whole thing.
//
// ---------------------------------------------------------------------------
procedure TCSCXMLParseMS.WriteIt(toWrite: IXMLDomNode; Level: Integer);
const
  AValue = -1;
var
  NodeName: string;
  Child: IXMLDomNode;
  S: string;
  Attributes: IXMLDOMNamedNodeMap;
  Attribute: IXMLDOMNode;
  AttrCount, i: Integer;
begin
  // Get the name and value out for convenience
  nodeName := toWrite.NodeName;
//  nodeValue := ' ff'; //toWrite.NodeValue;

  Inc(Level);
  case (toWrite.NodeType) of

    NODE_TEXT: begin
      if Assigned(FAnyNodeEvent) then
        FAnyNodeEvent(Self, 'text: ' + toWrite.nodeValue);

      if Assigned(FElementNodeEvent) then
        FElementNodeEvent(Self, Level - AValue, toWrite.NodeValue);
    end;

    NODE_PROCESSING_INSTRUCTION: begin
      if Assigned(FAnyNodeEvent) then
        FAnyNodeEvent(Self, '<?' + nodeName + ' ' + toWrite.nodeValue + '?>');
    end;

    NODE_DOCUMENT:
    begin
        // Bug here:  we need to find a way to get the encoding name
        //   for the default code page on the system where the
        //   program is running, and plug that in for the encoding
        //   name.
        if Assigned(FAnyNodeEvent) then
          FAnyNodeEvent(Self, '<?xml version=''1.0'' encoding=''ISO-8859-1'' ?>');

        child := toWrite.FirstChild;
        while (child <> nil) do begin
          WriteIt(child, Level);
          child := child.NextSibling;
        end;
    end;

    NODE_ELEMENT:
    begin
        // Output the element start tag.
        S := '<' + nodeName;

        // Output any attributes on this element
        attributes := toWrite.Attributes;
        attrCount := attributes.Length;

        if FBreakoutAttributes then
          if Assigned(FElementNodeEvent) then
              FElementNodeEvent(Self, Level - AValue, NodeName + ' Attributes');

        for i := 0 to attrCount - 1 do begin
          Attribute := attributes.item[i];
          S :=  S + ' ' + attribute.NodeName;
          S := S + attribute.NodeValue;

          if FBreakoutAttributes then begin
            if Assigned(FElementNodeEvent) then
              FElementNodeEvent(Self, Level - AValue + 1, attribute.NodeName);

            if Assigned(FElementNodeEvent) then
              FElementNodeEvent(Self, (Level - AValue) + 2, attribute.NodeValue);

            if Assigned(FAnyNodeEvent) then
              FAnyNodeEvent(Self, attribute.NodeName + 'Level: ' + IntToStr(Level));

            if Assigned(FAnyNodeEvent) then
              FAnyNodeEvent(Self, attribute.NodeValue + 'Level: ' + IntToStr(Level));
          end;
        end;

        //  Test for the presence of children, which includes both
        //  text content and nested elements.
        child := toWrite.FirstChild;
        if (child <> nil) then begin
          // There are children. Close start-tag, and output children.
          S := S + '>';

          if not FBreakoutAttributes then begin
            if Assigned(FElementNodeEvent) then
              FElementNodeEvent(Self, Level - AValue, S);

            if Assigned(FAnyNodeEvent) then
              FAnyNodeEvent(Self, S + 'Level: ' + IntToStr(Level));
          end;

          while( child <> nil) do begin
            WriteIt(child, Level);
            child := child.NextSibling;
          end;

          // Done with children.  Output the end tag.
          // AddToTree(Level - AValue, '</' + nodeName + '>');
          if Assigned(FAnyNodeEvent) then
            FAnyNodeEvent(Self, '</' + nodeName + '>'  + 'Level: ' + IntToStr(Level));
        end
        else
        begin
          //  There were no children.  Output the short form close of the
          //  element start tag, making it an empty-element tag.
          S := S + '/>';
          if not BreakoutAttributes then begin
            if Assigned(FElementNodeEvent) then
              FElementNodeEvent(Self, Level - AValue, S);

            if Assigned(FAnyNodeEvent) then
              FAnyNodeEvent(Self, S + ' Level: ' + IntToStr(Level));
          end;
        end;

    end;

    NODE_ENTITY_REFERENCE:
    begin
      if Assigned(FAnyNodeEvent) then
        FAnyNodeEvent(Self, 'Entity reference. Level: ' + IntToStr(Level));
      child := toWrite.FirstChild;
      while child <> nil do begin
        WriteIt(child, Level);
        child := child.NextSibling;
      end;
    end;


    NODE_CDATA_SECTION:
    begin
      S := '<![CDATA[' + toWrite.nodeValue + ']]>';
      if Assigned(FAnyNodeEvent) then
        FAnyNodeEvent(Self, S);
    end;

    NODE_COMMENT: begin
      if Assigned(FAnyNodeEvent) then
        FAnyNodeEvent(Self, '<!--' + toWrite.nodeValue + '-->');
    end;

 //   NODE_Xml_Declaration: Memo1.Lines.Add('<' + NodeName + '>');
    else
      if Assigned(FAnyNodeEvent) then
         FAnyNodeEvent(Self, 'Unrecognized node type = ' + IntToStr(Ord(toWrite.NodeType)));
  end;
end;

end.