Delphi备忘三：TCollection的使用，用Stream保存_delphi文章/教程_其他教程_编程语言

代码

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.