Chip 1998 March/Chip_1998-03_cd.bin/zkuste/delphi/WhiteAnts/CMPNAMES.ZIP/TEXTSTRM.PAS

Pascal/Delphi Source File | 1997-01-20 | 9.5 KB | 424 lines

unit TextStrm;

interface

uses Classes, SysUtils;

type
  TTextMode = (tmOpenRead, tmOpenWrite, tmOpenReadWrite, tmCreate, tmAppend);


type
  TTextStream = class(TObject)
  public
    function EndOfFile: Boolean; virtual; abstract;
    procedure NewLine;
    function ReadLine: String; virtual; abstract;
    procedure Reset; virtual; abstract;
    procedure WriteLine(const S: String); virtual; abstract;
    procedure WriteLnFmt(const S: String; const Pars: array of const);
  end;

type
  TTextFilter = class (TTextStream)
  private
    FOwnsBase: Boolean;
    FTextStream: TTextStream;
  protected
    function GetTextStream: TTextStream;
    procedure SetTextStream(Value: TTextStream);
  public
    constructor Create(ATextStream: TTextStream; AOwnsBase: Boolean);
    destructor Destroy; override;
    function EndOfFile: Boolean; override;
    function ReadLine: String; override;
    procedure Reset; override;
    procedure WriteLine(const Line: String); override;
    property OwnsBase: Boolean read FOwnsBase write FOwnsBase;
    property TextStream: TTextStream read GetTextStream write SetTextStream;
  end;

type
  TTextFile = class(TTextStream)
  private
    FMode: TTextMode;
    FText: Text;
  public
    constructor Create(const FileName: String; Mode: TTextMode);
    destructor Destroy; override;
    function EndOfFile: Boolean; override;
    function ReadLine: String; override;
    procedure Reset; override;
    procedure WriteLine(const Line: String); override;
  end;

type
  TStringsText = class (TTextStream)
  private
    FCurLine: Integer;
    FStrings: TStrings;
  protected
    procedure SetStrings(Value: TStrings); virtual;
  public
    constructor Create(AStrings: TStrings);
    destructor Destroy; override;
    function EndOfFile: Boolean; override;
    function LineCnt: Integer;
    function ReadLine: String; override;
    procedure Reset; override;
    procedure WriteLine(const Line: String); override;
    property Strings: TStrings read FStrings write SetStrings;
  end;

type
  EClipTextStreamError = class (Exception);

  TClipbrdTextStream = class(TTextStream)
  private
    FLines: TStringList;
    FLinePos: Word;
    FMode: TTextMode;
    procedure ReadFromClipboard;
    procedure WriteToClipboard;
  public
    constructor Create(Mode: TTextMode);
    destructor Destroy; override;
    function EndOfFile: Boolean; override;
    function ReadLine: String; override;
    procedure Reset; override;
    procedure WriteLine(const S: String); override;
  end;

type
  TIndentFilter = class (TTextFilter)
  private
    FIndention: Integer;
    procedure SetIndention(Value: Integer);
  public
    constructor Create(ATextStream: TTextStream; AIndention: Integer; AOwnsBase: Boolean);
    function ReadLine: String; override;
    procedure WriteLine(const Line: String); override;
    property Indention: Integer read FIndention write SetIndention;
  end;

implementation

uses WinTypes, WinProcs, Clipbrd, StrUtils, NumUtils;

{
************************************** TTextStream **************************************
}
procedure TTextStream.NewLine;
begin
  WriteLine('');
end;

procedure TTextStream.WriteLnFmt(const S: String; const Pars: array of const);
begin
  WriteLine(Format(S, Pars));
end;

{
************************************** TTextFilter **************************************
}
constructor TTextFilter.Create(ATextStream: TTextStream; AOwnsBase: Boolean);
begin
  inherited Create;
  TextStream := ATextStream;
  OwnsBase := AOwnsBase;
end;

destructor TTextFilter.Destroy;
begin
  TextStream := nil;
  inherited Destroy;
end;

function TTextFilter.EndOfFile: Boolean;
begin
  Result := TextStream.EndOfFile;
end;

function TTextFilter.GetTextStream: TTextStream;
begin
  Result := FTextStream;
end;

function TTextFilter.ReadLine: String;
begin
  Result := TextStream.ReadLine;
end;

procedure TTextFilter.Reset;
begin
  TextStream.Reset;
end;

procedure TTextFilter.SetTextStream(Value: TTextStream);
begin
  if Value <> FTextStream then
  begin
    if OwnsBase then FTextStream.Free;
    FTextStream := Value;
  end;
end;

procedure TTextFilter.WriteLine(const Line: String);
begin
  TextStream.WriteLine(Line);
end;

{
********************************** TTextFile **********************************
}
constructor TTextFile.Create(const FileName: String; Mode: TTextMode);
begin
  inherited Create;
  FMode := Mode;
  case FMode of
    tmOpenRead:
       begin
         AssignFile(FText, FileName);
         SYSTEM.Reset(FText);
       end;
    tmOpenWrite, tmCreate:
       begin
         AssignFile(FText, FileName);
         Rewrite(FText);
       end;
    tmAppend:
       begin
         AssignFile(FText, FileName);
         Append(FText);
       end;
  else
    raise EInOutError.Create('Illegal Mode for TextFile');
  end;
end;

destructor TTextFile.Destroy;
begin
  CloseFile(FText);
  inherited Destroy;
end;

function TTextFile.EndOfFile: Boolean;
begin
  Result := EOF(FText);
end;

function TTextFile.ReadLine: String;
begin
  ReadLn(FText, Result);
end;

procedure TTextFile.Reset;
begin
  SYSTEM.Reset(FText);
end;

procedure TTextFile.WriteLine(const Line: String);
begin
  WriteLn(FText, Line);
end;

{
************************************** TStringsText **************************************
}
constructor TStringsText.Create(AStrings: TStrings);
begin
  inherited Create;
  Strings := AStrings;
end;

destructor TStringsText.Destroy;
begin
  Strings := nil;
  inherited Destroy;
end;

function TStringsText.EndOfFile: Boolean;
begin
  Result := FCurLine = LineCnt;
end;

function TStringsText.LineCnt: Integer;
begin
  if Assigned(FStrings) then
    Result := FStrings.Count
  else
    Result := 0;
end;

function TStringsText.ReadLine: String;
begin
  if FCurLine < LineCnt then
  begin
    Result := FStrings[FCurLine];
    Inc(FCurLine);
  end
  else
   Result := '';
end;

procedure TStringsText.Reset;
begin
  FCurLine := 0;
end;

procedure TStringsText.SetStrings(Value: TStrings);
begin
  if FStrings <> Value then
  begin
    if Assigned(FStrings) then FStrings.EndUpdate;
    FStrings := Value;
    if Assigned(FStrings) then FStrings.BeginUpdate;
    Reset;
  end;
end;

procedure TStringsText.WriteLine(const Line: String);
begin
  if Assigned(FStrings) then
  begin
    if FCurLine < FStrings.Count then
      FStrings[FCurLine] := Line
    else
      FStrings.Add(Line);
    Inc(FCurLine);
  end;
end;

{
************************* TClipbrdTextStream **********************************
}
constructor TClipbrdTextStream.Create(Mode: TTextMode);
var ASize: LongInt;
begin
  if Mode in [tmOpenReadWrite] then
    raise EInOutError.Create('Illegal mode for clipboard text stream');
  inherited Create;
  FMode := Mode;
  FLines := TStringList.Create;
  FLinePos := 0;
  if FMode in [tmOpenRead, tmAppend] then ReadFromClipboard;
  if FMode = tmAppend then FLinePos := FLines.Count;
end;

destructor TClipbrdTextStream.Destroy;
begin
  if FMode in [tmOpenWrite, tmCreate, tmAppend] then WriteToClipboard;
  FLines.Free;
  inherited Destroy;
end;

function TClipbrdTextStream.EndOfFile: Boolean;
begin
  if FMode in [tmOpenWrite, tmCreate, tmAppend] then
    Result := True
  else
    Result := FLinePos = FLines.Count;
end;

function TClipbrdTextStream.ReadLine: String;
begin
  if FMode = tmOpenRead then
    if FLinePos >= FLines.Count then
      Result := ''
    else
    begin
      Result := FLines[FLinePos];
      Inc(FLinePos);
    end
  else
    raise EInOutError.Create('Can not read from write only stream')
end;

procedure TClipbrdTextStream.ReadFromClipboard;
var Buf: PChar;
    Data: THandle;
    DataPtr: Pointer;
    Size: Longint;
begin
  FLinePos := 0;
  if Clipboard.HasFormat(CF_TEXT) then
  begin
    GetMem(Buf, MaxInt);
    try
      Clipboard.GetTextBuf(Buf, MaxInt);
      FLines.SetText(Buf);
    finally
      FreeMem(Buf, MaxInt);
    end;
  end;
end;

procedure TClipbrdTextStream.Reset;
begin
  FLinePos := 0;
  if FMode <> tmOpenRead then FLines.Clear;
end;

procedure TClipbrdTextStream.WriteLine(const S: String);
begin
  if FMode <> tmOpenRead then
  begin
    FLines.Add(S);
    Inc(FLinePos);
  end
  else
    raise EInOutError.Create('Can not read from to write only stream')
end;

procedure TClipbrdTextStream.WriteToClipboard;
var
  I: Integer;
  Buf: PChar;
  Data: THandle;
  DataPtr: Pointer;
  Size: LongInt;
begin
  Clipboard.Open;
  try
    { Write text }
    if (FLines.Count > 0) then
    begin
      Buf := FLines.GetText; { allocated by Lines }
      try
        Clipboard.SetTextBuf(Buf);
      finally
        StrDispose(Buf); { Free here }
      end;
    end;
  finally
    Clipboard.Close;
  end;
end;

{
************************************* TIndentFilter **************************************
}
constructor TIndentFilter.Create(ATextStream: TTextStream; AIndention: Integer;
    AOwnsBase: Boolean);
begin
  inherited Create(ATextStream, AOwnsBase);
  SetIndention(AIndention);
end;

function TIndentFilter.ReadLine: String;
begin
  Result := BlankString(FIndention) + inherited ReadLine;
end;

procedure TIndentFilter.SetIndention(Value: Integer);
begin
  FIndention := Max2Int(0, Value);
end;

procedure TIndentFilter.WriteLine(const Line: String);
begin
  inherited WriteLine(BlankString(FIndention) + Line);
end;

end.