Delphi备忘三：TCollection的使用，用Stream保存

 

代码

unit  ufrmGetFunctionDefine;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,TypInfo,
  Dialogs,ufrmStockBaseCalc, StdCtrls, ComCtrls,uQEFuncManager,uWnDataSet,uDataService;

type


  TGettingParamDefine  =   class (TCollectionItem)
   private
    FName: string ;
    F_Type : DataType;
   public
     property  Name :  string   read  FName  write  FName;
     property  _Type : DataType  read  F_Type  write  F_Type;
   end ;

  TGettingParamDefines  =   class (TCollection)
   private
     function  GetItem(Index: Integer): TGettingParamDefine;
   public
     function  Add: TGettingParamDefine;
     function  FindByName(AName:  string ): TGettingParamDefine;
     function  FindByIndex(AIndex : Integer) : TGettingParamDefine;
     property  Items[Index: Integer]: TGettingParamDefine  read  GetItem;  default ;
   end ;

  TGettingFunctionDefine  =   class (TCollectionItem)
   private
    FName: string ;
    FResultType:DataType;
    FParamDefines:TGettingParamDefines;
   public
     property  Name :  string   read  FName  write  FName;
     property  ResultType: DataType  read  FResultType  write  FResultType;
     // 函数的参数定义
     property  ParamDefines: TGettingParamDefines  read  FParamDefines  write  FParamDefines;
     constructor  Create(Collection: TCollection);  override ;
     destructor  Destroy;  override ;
   end ;

  TGettingFunctionDefines  =   class (TCollection)
     function  GetItem(Index: Integer): TGettingFunctionDefine;
   public
     function  Add: TGettingFunctionDefine;
     function  FindByName(AName:  string ): TGettingFunctionDefine;
     function  FindByIndex(AIndex : Integer) : TGettingFunctionDefine;
     property  Items[Index: Integer]: TGettingFunctionDefine  read  GetItem;  default ;
   end ;


  TfrmGetFunctionDefine  =   class (TfrmStockBaseCalc)
    edtFunctionList: TMemo;
    tvwFunction: TTreeView;
    btnGet: TButton;
    btnShowFunction: TButton;
    btnSaveStream: TButton;
    dlgSaveFile: TSaveDialog;
    btnLoadStream: TButton;
    dlgOpenFile: TOpenDialog;
     procedure  btnGetClick(Sender: TObject);
     procedure  FormCreate(Sender: TObject);
     procedure  FormClose(Sender: TObject;  var  Action: TCloseAction);
     procedure  btnShowFunctionClick(Sender: TObject);
     procedure  btnSaveStreamClick(Sender: TObject);
     procedure  btnLoadStreamClick(Sender: TObject);
   private
    FQEFunctionManager:TQEFunctionManager;
    FGettingFunctionDefines : TGettingFunctionDefines;
     {  Private declarations  }
   public
     {  Public declarations  }
   end ;

implementation

{ $R *.dfm }

procedure  TfrmGetFunctionDefine.btnGetClick(Sender: TObject);
var
    i,j:integer;
    LFunction: TQEFunctionDefine;
    LGettingFunctionDefine:TGettingFunctionDefine;
    LGettingParamDefine:TGettingParamDefine;
begin
     for  i: = 0   to  edtfunctionlist.Lines.Count - 1   do
     begin
      LFunction : =  FQEFunctionManager.RootGroup.FindNodeByNotIsLink(edtfunctionlist.Lines[i]) ;
       if   not  assigned(LFunction)  then
        showmessage( ' 没有 ' +  edtfunctionlist.Lines[i])
       else
       begin
        LGettingFunctionDefine : =  FGettingFunctionDefines.Add;
        LGettingFunctionDefine.Name : =  edtfunctionlist.Lines[i];
        LGettingFunctionDefine.ResultType : =  DataType(CaseFuncTypeToDataType(LFunction.ResultType));
         for  j: = 0   to  LFunction.ParamDefines.Count - 1   do
         begin
          LGettingParamDefine : =  LGettingFunctionDefine.ParamDefines.Add;
          LGettingParamDefine.Name : =  LFunction.ParamDefines[j].Name;
          LGettingParamDefine._Type : =  CaseFuncTypeToDataType(LFunction.ParamDefines[j].ParamType);
         end ;
       end ;
     end ;
end ;

procedure  TfrmGetFunctionDefine.FormClose(Sender: TObject;
   var  Action: TCloseAction);
begin
   inherited ;
  FGettingFunctionDefines.Free;
end ;


procedure  TfrmGetFunctionDefine.FormCreate(Sender: TObject);
begin
  FQEFunctionManager : =  CreateFunctionManager;
  FGettingFunctionDefines : =  TGettingFunctionDefines.Create(TGettingFunctionDefine);
end ;

procedure  TfrmGetFunctionDefine.btnShowFunctionClick(Sender: TObject);
var
  I,J:integer;
  LTreeNode,LChildTreeNode: TTreeNode;
begin
   tvwFunction.Items.Clear;
    for  i: = 0   to  FGettingFunctionDefines.Count - 1   do
    begin
     LTreeNode : =  tvwfunction.Items.Add( nil ,FGettingFunctionDefines[i].Name);
     tvwfunction.Items.AddChild(LTreeNode, ' Result: ' + GetEnumName(typeInfo(DataType),ord(FGettingFunctionDefines[i].ResultType)));
      for  j: = 0   to  FGettingFunctionDefines[i].ParamDefines.Count - 1   do
      begin
       LChildTreeNode : =  tvwfunction.Items.AddChild(LTreeNode, ' Param ' + inttostr(j) + ' : ' + FGettingFunctionDefines[i].ParamDefines[j].Name);
       tvwfunction.Items.AddChild(LChildTreeNode,GetEnumName(typeInfo(DataType),ord(FGettingFunctionDefines[i].ParamDefines[j]._Type)));
      end ;
    end ;
end ;

procedure  TfrmGetFunctionDefine.btnSaveStreamClick(Sender: TObject);
var
  LFileStream : TFileStream;
  LWriter : TWriter;
  I,J: Integer;
begin
// 写入流文件
   if  dlgSaveFile.Execute  then
   begin
     if  FileExists(dlgSaveFile.FileName)  then
     begin
      showmessage( ' 文件已经存在 ' );
      exit;
     end ;
    LFileStream : =  TFileStream.Create(dlgSaveFile.FileName,fmCreate);
     try
      LWriter : =  TWriter.Create(LFileStream, 4096 );
       try
        LWriter.WriteListBegin;
        LWriter.WriteInteger(FGettingFunctionDefines.Count);
         for  i: = 0   to  FGettingFunctionDefines.Count - 1   do
         begin
          LWriter.WriteString(FGettingFunctionDefines[i].Name);
          LWriter.WriteInteger(ord(FGettingFunctionDefines[i].ResultType));
          LWriter.WriteInteger(FGettingFunctionDefines[i].ParamDefines.Count);
           for  j: = 0   to  FGettingFunctionDefines[i].ParamDefines.Count - 1   do
           begin
            LWriter.WriteString(FGettingFunctionDefines[i].ParamDefines[j].Name);
            LWriter.WriteInteger(ord(FGettingFunctionDefines[i].ParamDefines[j]._Type));
           end ;
         end ;
        LWriter.WriteListEnd;
        LFileStream.Seek( 0 ,soFromBeginning);
       finally
        LWriter.Free;
       end ;
       // FileWrite(FileHandle,FGettingFunctionDefines,sizeof(FGettingFunctionDefines));
     finally
      LFileStream.Free;
     end ;

   end ;

end ;

procedure  TfrmGetFunctionDefine.btnLoadStreamClick(Sender: TObject);
var
  i,j,LType:integer;
  LFunctionCount,LParamCount:integer;
  LGettingFunctionDefine:TGettingFunctionDefine;
  LGettingParamDefine:TGettingParamDefine;
  LFileStream : TFileStream;
  LReader : TReader;
begin
   if  dlgOpenFile.Execute  then
   begin
     if   not  fileexists(dlgOpenFile.FileName)  then
     begin
      showmessage( ' 文件已经不存在 ' );
      exit;
     end ;
    LFileStream : =  TFileStream.Create(dlgOpenFile.FileName,fmOpenRead);
     try
      LReader : =  TReader.Create(LFileStream, 4096 );
       try
        LFileStream.Seek( 0 ,soFromBeginning);
        LReader.ReadListBegin;
        LFunctionCount: = LReader.ReadInteger;
         for  i: = 0   to  LFunctionCount - 1   do
         begin
          LGettingFunctionDefine : =  FGettingFunctionDefines.Add;
          LGettingFunctionDefine.Name : =  LReader.ReadString;
          LGettingFunctionDefine.ResultType : =  DataType(LReader.ReadInteger);
          LParamCount : =  LReader.ReadInteger;
           for  j: = 0   to  LParamCount - 1   do
           begin
            LGettingParamDefine : =  LGettingFunctionDefine.ParamDefines.Add;
            LGettingParamDefine.Name : =  LReader.ReadString;
            LType : =  LReader.ReadInteger;
            LGettingParamDefine._Type : =  DataType(LType);
           end ;
         end ;
        LReader.ReadListEnd;
        LFileStream.Seek( 0 ,soFromBeginning);
       finally
        LReader.Free;
       end ;
     finally
      LFileStream.Free;
     end ;
   end ;
end ;

{  TGettingParamDefines  }

function  TGettingParamDefines.Add: TGettingParamDefine;
begin
  Result : =  TGettingParamDefine( inherited  Add);
end ;

function  TGettingParamDefines.FindByIndex(
  AIndex: Integer): TGettingParamDefine;
begin
  Result : =   nil ;

   if  (AIndex < 0 )  or  (AIndex  >  Count - 1 )  then  exit;

  result : =  Self[AIndex];
end ;

function  TGettingParamDefines.FindByName(
  AName:  string ): TGettingParamDefine;
var
  I: Integer;
begin
  Result : =   nil ;
   for  I : =   0   to  Count  -   1   do
     if  CompareText(Self[I].Name, AName)  =   0   then
     begin
      Result : =  Self[I];
      Break;
     end ;
end ;

function  TGettingParamDefines.GetItem(Index: Integer): TGettingParamDefine;
begin
  Result : =  TGettingParamDefine( inherited  GetItem(Index));
end ;

{  TGettingFunctionDefines  }

function  TGettingFunctionDefines.Add: TGettingFunctionDefine;
begin
    Result : =  TGettingFunctionDefine( inherited  Add);
end ;

function  TGettingFunctionDefines.FindByIndex(
  AIndex: Integer): TGettingFunctionDefine;
begin
  Result : =   nil ;

   if  (AIndex < 0 )  or  (AIndex  >  Count - 1 )  then  exit;

  result : =  Self[AIndex];
end ;

function  TGettingFunctionDefines.FindByName(
  AName:  string ): TGettingFunctionDefine;
var
  I: Integer;
begin
  Result : =   nil ;
   for  I : =   0   to  Count  -   1   do
     if  CompareText(Self[I].Name, AName)  =   0   then
     begin
      Result : =  Self[I];
      Break;
     end ;
end ;

function  TGettingFunctionDefines.GetItem(
  Index: Integer): TGettingFunctionDefine;
begin
     Result : =  TGettingFunctionDefine( inherited  GetItem(Index))
end ;

{  TGettingFunctionDefine  }

constructor  TGettingFunctionDefine.Create(Collection: TCollection);
begin
   inherited ;
  FParamDefines : =  TGettingParamDefines.Create(TGettingParamDefine);    s
end ;

destructor  TGettingFunctionDefine.Destroy;
begin
  FParamDefines.Free;
   inherited ;
end ;

end .