utxtaddsubx.pas

这个程序的基础框架部分是我在玩OOP玩得走火入魔的时候写的（当然那个时候是有意要走火入魔的了:-）。当时本来是想做一个光盘目录管理之类的东西

{*******************************************************}
{                                                       }
{       DirTree Demo                                    }
{                                                       }
{       版权所有 (C) 2005 zbird                         }
{                                                       }
{*******************************************************}

unit uTxtAddSubX;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  uIntAddSubX;

type
  TvxTxtAddSubFileFactory = class(TInterfacedObject, IvxAddSubFileFactory)
  private
    FStream: TStream;
    FLevel: Integer;
  public
    constructor Create(aStream: TStream); overload;
    constructor Create(aStream: TStream; aLevel: Integer); overload;
    function AddSubDir(aFileName: string; aSearchRec: TSearchRec):
            IvxAddSubFileFactory; stdcall;
    procedure AddSubFile(aFileName: string; aSearchRec: TSearchRec); stdcall;
  end;

  TvxTxtBaseAddSubFile = class(TInterfacedObject, IvxAddSubFile)
  private
    FStream: TStream;
    FLevel: Integer;
  public
    constructor Create(aStream: TStream); overload;
    constructor Create(aStream: TStream; aLevel: Integer); overload;
    procedure AddSubFile(aFileName: string; aSearchRec: TSearchRec); stdcall;
  end;
  

implementation

{
*************************** TvxTxtAddSubFileFactory ****************************
}
constructor TvxTxtAddSubFileFactory.Create(aStream: TStream);
begin
  FStream := aStream;
  FLevel := 0;
end;

constructor TvxTxtAddSubFileFactory.Create(aStream: TStream;
  aLevel: Integer);
begin
  FStream := aStream;
  FLevel := aLevel;
end;

function TvxTxtAddSubFileFactory.AddSubDir(aFileName: string; aSearchRec:
        TSearchRec): IvxAddSubFileFactory;
var
  tmpStr: string;
  i: Integer;
begin
  for i := 1 to FLevel do
  begin
    tmpStr := tmpStr + '    ';
  end;
  tmpStr := tmpStr + '[' + aSearchRec.Name + ']' + #13 + #10;
  FStream.WriteBuffer(Pointer(tmpStr)^, Length(tmpStr));
  Result := TvxTxtAddSubFileFactory.Create(FStream, FLevel + 1);
end;

procedure TvxTxtAddSubFileFactory.AddSubFile(aFileName: string; aSearchRec:
        TSearchRec);
var
  AddSubFile: IvxAddSubFile;
begin
  AddSubFile := TvxTxtBaseAddSubFile.Create(FStream, FLevel);
  AddSubFile.AddSubFile(aFileName, aSearchRec);
end;

{
***************************** TvxTxtBaseAddSubFile *****************************
}
constructor TvxTxtBaseAddSubFile.Create(aStream: TStream);
begin
  FStream := aStream;
end;

constructor TvxTxtBaseAddSubFile.Create(aStream: TStream; aLevel: Integer);
begin
  FStream := aStream;
  FLevel := aLevel;
end;

procedure TvxTxtBaseAddSubFile.AddSubFile(aFileName: string; aSearchRec:
        TSearchRec);
var
  tmpStr: string;
  i: Integer;
begin
  for i := 1 to FLevel do
  begin
    tmpStr := tmpStr + '    ';
  end;
  tmpStr := tmpStr + aSearchRec.Name + '    Size:%8.2fK' + #13 + #10;
  tmpStr := Format(tmpStr, [123.456]);
  FStream.WriteBuffer(Pointer(tmpStr)^, Length(tmpStr));
end;

end.