STSTREAM

{ Delphi1 komponens }

{ Agócs László 2001 }

{ TStStream : TMemoryStream kompones kibővitett lehetőségekkel.

            rec - fix hosszúságú rekordok tárolására szolgál,

            így a RecNo property az aktuális rekordra mutat:

                0 = a stream eleje; 2 = a 3. rekord eleje

                (RecNo = n-1); }

unit Ststream;

interface

Uses SysUtils, WinTypes, WinProcs, Classes, StdCtrls;

Type

  TSTStream = class(TMemoryStream)

  private

    FBOF            : boolean;    {Stream eleje}

    FEOF            : boolean;    {Stream vége}

    FRecNo          : longint;    {Aktuális rekord sorszáma}

    FRecSize        : word;       {Rekord mérete}

    FRecNoCountLabel: TLabel;     {Rekord sorszám/rekordszám label}

    function GetRecNo:longint;

    procedure SetRecNo(Value:longint);

    function GetRecCount:longint;

    procedure SetRecSize(Value:word);

    procedure SetRecNoCountLabel(Value:TLabel);

  protected

    ths    : TMemoryStream;

  public

    constructor Create;

    destructor Destroy;override;

    procedure GoTop;                     {Stream elejére ugrik}

    procedure GoBottom;                  {Stream végére ugrik}

    procedure GoRec(Recno:longint);      {Stream adott pos.-jú rekordjára ugrik}

    procedure Add(var rec);              {Uj rekordot fűz a stream végére}

    procedure Ins(var rec);              {Uj rekordot szúr be a stream aktuális poziciójába}

    procedure Del(var rec);              {Törli a rekordot a stream aktuális poziciójában}

    function WriteRec(var rec;Recno:longint):boolean;

             {Rekordot ír a Recno. rekordba}

    function ReadRec(var rec;Recno:longint):boolean;

             {Rekordot olvas a Recno. rekordból}

    property BOF: boolean read FBOF write FBOF;

    property EOF: boolean read FEOF write FEOF;

    property RecNo: longint read GetRecNo write SetRecNo;

    property RecCount: longint read GetRecCount;

    property RecSize: word read FRecSize write SetRecSize;

    property RecNoCountLabel: TLabel read FRecNoCountLabel write SetRecNoCountLabel;

   end;

implementation

constructor TSTStream.Create;

begin

   inherited Create;

   ths    := TMemoryStream.Create;

   FRecSize:= 0;

   FBOF   := True;

   FEOF   := True;

end;

destructor TSTStream.Destroy;

begin

   ths.Free;

   inherited Destroy;

end;

function TSTStream.GetRecNo:longint;

begin

Result := Position div RecSize;

FBOF := Position=0;

FEOF := Size = Position;

end;

procedure TSTStream.SetRecNo(Value:longint);

begin

FRecno := Value;

Seek(Value*RecSize,0);

If (RecNoCountLabel<>nil) then

   RecNoCountLabel.Caption:=IntToStr(FRecno)+'/'+IntToStr(RecCount);

FBOF := Position=0;

FEOF := Size = Position;

end;

function  TSTStream.GetRecCount:longint;

begin

If RecSize=0 then Result:=0 else

Result := Size div RecSize;

end;

procedure TSTStream.SetRecSize(Value:word);

begin

FRecSize := Value;

RecNo := RecNo;

end;

procedure TSTStream.SetRecNoCountLabel(Value:TLabel);

begin

FRecNoCountLabel:=Value;

RecNo := RecNo;

end;

procedure TSTStream.GoTop;

begin

Seek(0,0);

BOF := True;

end;

procedure TSTStream.GoBottom;

begin

Seek(0,2);

EOF := True;

end;

procedure TSTStream.GoRec(Recno:longint);

begin

Seek(Recno*RecSize,0);

end;

procedure TSTStream.Add(var rec);

begin

GoBottom;

Write(rec,SizeOf(rec));

end;

procedure TSTStream.Ins(var rec);

var rno: longint;

  r : array[1..Sizeof(rec)] of Char;

begin

ths.Clear;

SaveToStream(ths);

meret := Size div SizeOf(rec);

ths.Seek(0,0)

Clear;

For i:=1 to rno-1 do begin

    ths.read(r,SizeOf(rec));

    write(r,SizeOf(rec));

end;

write(rec,SizeOf(rec));

For i:=rno-1 to meret do begin

    ths.read(r,SizeOf(rec));

    write(r,SizeOf(rec));

end;

ths.Clear;

end;

procedure TSTStream.Del(var rec);

begin

end;

{Rekordot ír a Recno. rekordba}

function TSTStream.WriteRec(var rec;Recno:longint):boolean;

begin

Try

  Result := True;

  GoRec(Recno);

  Write(rec,SizeOf(rec));

except

  Result := False;

end;

end;

{Rekordot olvas a Recno. rekordból}

function TSTStream.ReadRec(var rec;Recno:longint):boolean;

begin

Try

  Result := True;

  GoRec(Recno);

  Read(rec,SizeOf(rec));

except

  Result := False;

end;

end;

end.