treeexport.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

unit TreeExport;

interface

uses
  {$IFNDEF LINUX}
  Windows, Messages,
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF CLX}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QComCtrls, QExtCtrls,
  {$ELSE}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls,
  {$ENDIF}
  TeeExport, TeeTree, TeCanvas, TeeProcs;

type
  TTreeExportForm = class(TTeeExportFormBase)
    CBFullSize: TCheckBox;
    procedure FormShow(Sender: TObject);
    procedure CBFullSizeClick(Sender: TObject);
  private
    { Private declarations }
  protected
    Function CreateData:TTeeExportData; override;
    Function CreateNativeStream:TStream; override;
    Function ExistData:Boolean; override;
  public
    { Public declarations }
  end;

   TTreeData=class(TTeeExportData)
   private
     FTree : TCustomTree;
   protected
     Function NodeToString(Index:Integer):String; virtual;
   public
     Constructor Create(ATree:TCustomTree); virtual;

     Function AsString:String; override;
     property Tree:TCustomTree read FTree write FTree;
   end;

   TTreeDataText=class(TTreeData)
   private
     FTextDelimiter : {$IFDEF CLX}WideChar{$ELSE}Char{$ENDIF};
   protected
     Function NodeToString(Index:Integer):String; override;
   public
     Constructor Create(ATree:TCustomTree); override;

     Function AsString:String; override;
     property TextDelimiter:{$IFDEF CLX}WideChar{$ELSE}Char{$ENDIF}
            read FTextDelimiter write FTextDelimiter default TeeTabDelimiter;
   end;

   TTreeDataXML=class(TTreeData)
   public
     {$IFDEF CLR}
     Constructor Create(ATree:TCustomTree); override;
     {$ENDIF}

     Function AsString:String; override;
   end;

   TTreeDataHTML=class(TTreeData)
   protected
     Function NodeToString(Index:Integer):String; override;
   public
     {$IFDEF CLR}
     Constructor Create(ATree:TCustomTree); override;
     {$ENDIF}

     Function AsString:String; override;
   end;

   {$IFNDEF CLR}
   TTreeDataXLS=class(TTreeData)
   public
     {$IFDEF CLR}
     Constructor Create(ATree:TCustomTree); override;
     {$ENDIF}

     Procedure SaveToStream(AStream:TStream); override;
   end;
   {$ENDIF}

implementation

{$IFNDEF CLX}
{$R *.DFM}
{$ELSE}
{$R *.xfm}
{$ENDIF}

Const TeeTextLineSeparator= #13#10;

Function TTreeExportForm.CreateData:TTeeExportData;

  function Tree: TCustomTree;
  begin
    result:=TCustomTree(ExportPanel);
  end;

begin
  Case RGText.ItemIndex of
    0: begin
         result:=TTreeDataText.Create(Tree);
         TTreeDataText(result).TextDelimiter:=GetSeparator;
       end;
    1: result:=TTreeDataXML.Create(Tree);
    2: result:=TTreeDataHTML.Create(Tree);
  {$IFNDEF CLR}
  else
    result:=TTreeDataXLS.Create(Tree);
  {$ENDIF}
  end;
end;

function TTreeExportForm.ExistData: Boolean;
begin
  result:=(ExportPanel is TCustomTree) and
          (TCustomTree(ExportPanel).Shapes.Count>0);
end;

procedure TTreeExportForm.FormShow(Sender: TObject);
begin
  inherited;
  TabData.TabVisible:=True;
  CBFullSizeClick(Sender); //tom:26/11/2002; Set default to full size  
end;

{ TTreeData }

function TTreeData.AsString: String;
var t : Integer;
begin
  result:='';
  for t:=0 to Tree.Roots.Count-1 do
      result:=result+NodeToString(t)+TeeTextLineSeparator;
end;

constructor TTreeData.Create(ATree: TCustomTree);
begin
  {$IFDEF CLR}
  inherited Create;
  {$ENDIF}
  FTree:=ATree;
end;

function TTreeData.NodeToString(Index: Integer): String;
begin
  result:='';
end;

{ TTreeDataText }

function TTreeDataText.AsString: String;
begin
  result:=result+inherited AsString+TeeTextLineSeparator;
end;

constructor TTreeDataText.Create(ATree: TCustomTree);
begin
  inherited;
  FTextDelimiter:=TeeTabDelimiter;
end;

function TTreeDataText.NodeToString(Index: Integer): String;

   Function NodeText(ANode:TTreeNodeShape):String;
   var t : Integer;
   begin
     result:='';
     for t:=1 to ANode.Level do
         result:=result+FTextDelimiter;
     result:=result+ANode.SimpleText;
     for t:=1 to ANode.Text.Count-1 do
         result:=result+' '+ANode.Text[t];

     for t:=0 to ANode.Children.Count-1 do
         result:=result+TeeTextLineSeparator+NodeText(ANode.Children[t]);
   end;

begin
  result:=NodeText(Tree.Roots[Index])+TeeTextLineSeparator;
end;

{ TTreeDataXML }

{$IFDEF CLR}
Constructor TTreeDataXML.Create(ATree:TCustomTree);
begin
  inherited Create(ATree);
end;
{$ENDIF}

function TTreeDataXML.AsString: String;

  Function XMLNode(ANode: TTreeNodeShape):String;
  var t : Integer;
  begin
    result:=
          '<node name="'+ANode.Name+'" class="'+
          ANode.ClassName+'">'+ANode.Text.Text+TeeTextLineSeparator+
          '</node>'+TeeTextLineSeparator+TeeTextLineSeparator;
    for t:=0 to ANode.Children.Count-1 do
        result:=result+XMLNode(ANode.Children[t]);
  end;

var t : Integer;
begin
  result:='<?xml version="1.0" ?>'+TeeTextLineSeparator;
  result:=result+'<tree>'+TeeTextLineSeparator;
  for t:=0 to Tree.Roots.Count-1 do result:=result+XMLNode(Tree.Roots[t]);
  result:=result+'</tree>';
end;

{ TTreeDataHTML }

{$IFDEF CLR}
Constructor TTreeDataHTML.Create(ATree:TCustomTree);
begin
  inherited Create(ATree);
end;
{$ENDIF}

function TTreeDataHTML.AsString: String;
begin
  result:='<table border="1">'+TeeTextLineSeparator;
  result:=result+inherited AsString+TeeTextLineSeparator+'</table>';
end;

function TTreeDataHTML.NodeToString(Index: Integer): String;

  Function NodeHTML(ANode:TTreeNodeShape):String;
  var t : Integer;
  begin
    result:='<tr>';
    for t:=1 to ANode.Level do
        result:=result+'<td></td>';

    result:=result+'<td>'+ANode.SimpleText;
    for t:=1 to ANode.Text.Count-1 do
        result:=result+' '+ANode.Text[t];
    result:=result+'</td></tr>';

    for t:=0 to ANode.Children.Count-1 do
        result:=result+TeeTextLineSeparator+NodeHTML(ANode.Children[t]);
  end;

begin
  result:=NodeHTML(Tree.Roots[Index]);
end;

{ TTreeDataXLS }
{$IFNDEF CLR}

{$IFDEF CLR}
Constructor TTreeDataXLS.Create(ATree:TCustomTree);
begin
  inherited Create(ATree);
end;
{$ENDIF}

procedure TTreeDataXLS.SaveToStream(AStream: TStream);
Const Attr:Array[0..2] of Byte=(0,0,0);
var Buf : Array[0..4] of Word;
    Row : Integer;
    Col : Integer;

  Procedure WriteBuf(Value,Size:Word);
  begin
    Buf[0]:=Value;
    Buf[1]:=Size;
    AStream.Write(Buf,2*SizeOf(Word));
  end;

  Procedure WriteParams(Value,Size:Word);
  begin
    WriteBuf(Value,Size+2*SizeOf(Word)+SizeOf(Attr));
    WriteBuf(Row,Col);
    AStream.Write(Attr,SizeOf(Attr));
  end;

  procedure WriteDouble(Const Value:Double);
  begin
    WriteParams(3,SizeOf(Double));
    AStream.WriteBuffer(Value,SizeOf(Double));
  end;

  procedure WriteText(Const Value:ShortString);
  begin
    WriteParams(4,Length(Value)+1);
    AStream.Write(Value,Length(Value)+1)
  end;

  procedure WriteNull;
  begin
    WriteParams(1,0);
  end;

  procedure WriteNode(ANode:TTreeNodeShape);
  var t : Integer;
      s : String;
  begin
    for t:=0 to ANode.Level-1 do
    begin
      Col:=t;
      WriteNull;
    end;

    Col:=ANode.Level;

    s:=ANode.SimpleText;
    for t:=1 to ANode.Text.Count-1 do
        s:=s+' '+ANode.Text[t];

    WriteText(s);
    Inc(Row);

    for t:=0 to ANode.Children.Count-1 do
        WriteNode(ANode.Children[t]);
  end;

  Function MaxLevel:Integer;
  var t   : Integer;
      tmp : Integer;
  begin
    result:=0;
    for t:=0 to Tree.Shapes.Count-1 do
    begin
      tmp:=Tree.Shapes[t].Level;
      if tmp>result then result:=tmp;
    end;
  end;

Const BeginExcel : Array[0..5] of Word=($809,8,0,$10,0,0);
      EndExcel   : Array[0..1] of Word=($A,0);
Var t : Integer;
begin
  AStream.WriteBuffer(BeginExcel,SizeOf(BeginExcel)); { begin and BIF v5 }

  WriteBuf($0200,5*SizeOf(Word));  { row x col }

  Buf[0]:=0;
  Buf[2]:=0;
  Buf[3]:=MaxLevel+1; { columns }
  Buf[4]:=0;

  Buf[1]:=Tree.Shapes.Count; { rows }

  AStream.Write(Buf,5*SizeOf(Word));

  Row:=0;
  for t:=0 to Tree.Roots.Count-1 do WriteNode(Tree.Roots[t]);

  AStream.WriteBuffer(EndExcel,SizeOf(EndExcel)); { end }
end;
{$ENDIF}

procedure TTreeExportForm.CBFullSizeClick(Sender: TObject);
begin
  if Assigned(ExportPanel) then
  begin
    UDHeight.Position:=ExportPanel.GetRectangle.Bottom;
    UDWidth.Position:=ExportPanel.GetRectangle.Right;
  end;

  UDHeight.Enabled := not CBFullSize.Checked; //tom:26/11/2002; Allow full size
  UDWidth.Enabled := not CBFullSize.Checked; //tom:26/11/2002; Allow full size
  EHeight.Enabled := not CBFullSize.Checked; //tom:26/11/2002; Allow full size
  EWidth.Enabled := not CBFullSize.Checked; //tom:26/11/2002; Allow full size
  inherited;
end;

Function TTreeExportForm.CreateNativeStream:TStream;
var tmp : TStream;
begin
  result:=inherited CreateNativeStream;

  if NativeAsText then
  begin
    tmp:=result;
    try
      tmp.Position:=0;
      result:=TMemoryStream.Create;
      ObjectBinaryToText(tmp,result);
    finally
      tmp.Free;
    end;
  end
end;

end.