STSTREAM |
Top Previous Next |
{ 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.
|