unit ObjStringList;
{ StringList that owns TPersistent Objects, can load/save all published props from/to file }
interface
uses
  Classes, UtlType, WinUtl, PropUtl;

type
  TObjStringList = class(TStringList)
  protected
    { Parse the file content, where the values for the whole list are stored,
      load TObjStringList published properties and creates items. }
    procedure ParseTextStr(const Value: string);
      { Called from ParseTextStr for the first input line (containig TAB delimited
        published properties of the TObjStringList). }
      procedure AddLine(const ALine: string);
      { Called from ParseTextStr for all but the first input line, creates
        all TPersistent items by calling ObjCreate. }
      procedure AddHeader(const ALine: string);

    { Returns TAB delimited values of String[i] + published properties of Objects[i] for
      saving in file. }
    function GetLine(i:integer): string;

    { Can be overriden if some published properties defined in descendant. }
    function ObjCreate: TPersistent; virtual;
    procedure ObjSetValues(AObj: TPersistent; const APropValues: string);
  public
    { Call to add new line and objects - AString is the line string, APropValues contains
       TAB separated published properties from which AObj will be created using
      (eventually overriden) ObjCreate method. }
    function ObjAdd(const AString: string; const APropValues: string; var AObj: TPersistent): integer; virtual;
    procedure Delete(Index: Integer); override;
    procedure Clear;override;
    destructor Destroy;override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromStream(Stream: TStream); override;
  end;                {settextstr}

implementation

procedure TObjStringList.Delete(Index: Integer);
begin
  Objects[Index].Free;
  Objects[Index] := nil;
  inherited;
end;

function TObjStringList.ObjCreate: TPersistent;
begin
  Result := TPersistent.Create;
end;

procedure TObjStringList.ObjSetValues(AObj: TPersistent; const APropValues: string);
var
  w, l: string;
  i: integer;
begin
  l := APropValues;
  i := 0;
  while ExtractWord([TabChar], w, l) do begin
    if ClassSetPropStr(AObj, i, w) = 0 then
      break;
    inc(i);
  end;
end;

procedure TObjStringList.Clear;
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    Objects[i].Free;
    Objects[i] := nil;
  end;
  inherited;
end;

destructor TObjStringList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TObjStringList.SaveToStream(Stream: TStream);
var
  i: integer;
  ss: TStringStream;
  hdr:string;
  v: AnsiString;
const
  crlf:array[0..1] of char = (#13,#10);
begin
  ss := TStringStream.Create('');
  try
    i := 0;
    hdr := '';
    while ClassGetPropStr(Self, i, v) do begin
      if i = 0 then
        hdr := v
      else
        hdr := hdr + TabChar + v;
      inc(i);
    end;
    ss.WriteString(hdr);
    Stream.CopyFrom(ss, 0); {tstream}
    Stream.WriteBuffer(crlf, sizeof(crlf));

    for i := 0 to Count - 1 do begin
      ss.Size := 0;
      ss.WriteString(GetLine(i));
      Stream.CopyFrom(ss, 0); {tstream}
      Stream.WriteBuffer(crlf, sizeof(crlf));
    end;
  finally
    ss.Free;
  end;
end;

function TObjStringList.GetLine(i:integer): string;
var
  j: integer;
  p: TPersistent;
  v: AnsiString;
begin
  Result := '';
  if (i < 0) or (i >= Count) then
    exit;
  j := 0;
  Result := Strings[i];
  p := TPersistent(Objects[i]);
  if p is TPersistent then
  while ClassGetPropStr(p, j, v) do begin
    Result := Result + TabChar + v;
    inc(j);
  end;
end;

procedure TObjStringList.AddHeader(const ALine: string);
var
  w, l: string;
  i: integer;
begin
  l := ALine;
  i := 0;
  while ExtractWord([TabChar], w, l) do begin
    if ClassSetPropStr(Self, i, w) = 0 then
      break;
    inc(i);
  end;
end;

procedure TObjStringList.AddLine(const ALine: string);
var
  w, l: string;
  p: TPersistent;
begin
  l := ALine;
  if ExtractWord([TabChar], w, l) then begin
    p := ObjCreate;
    ObjSetValues(p, l);
    AddObject(w, p);
  end;
end;

function TObjStringList.ObjAdd(const AString: string; const APropValues: string; var AObj: TPersistent): integer;
begin
  AObj := ObjCreate;
  ObjSetValues(AObj, APropValues);
  Result := AddObject(AString, AObj);
end;

procedure TObjStringList.ParseTextStr(const Value: string);
var
  P, Start: PChar;
  S: string;
  i:integer;
begin
  BeginUpdate;
  try
    i := 0;
    Clear;
    P := Pointer(Value);
    if P <> nil then
      while P^ <> #0 do
      begin
        Start := P;
        while not (P^ in [#0, #10, #13]) do Inc(P);
        SetString(S, Start, P - Start);
        if i = 0 then
          AddHeader(s)
        else
          AddLine(S);
        inc(i);
        if P^ = #13 then Inc(P);
        if P^ = #10 then Inc(P);
      end;
  finally
    EndUpdate;
  end;
end;

procedure TObjStringList.LoadFromStream(Stream: TStream);
var
  Size: Integer;
  S: string;
begin
  BeginUpdate;
  try
    Size := Stream.Size - Stream.Position;
    SetString(S, nil, Size);
    Stream.Read(Pointer(S)^, Size);
    ParseTextStr(S);
  finally
    EndUpdate;
  end;
end;

end.
