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

type
  TObjStringList = class(TStringList)
  protected
    procedure AddLine(const ALine: string);
    procedure AddHeader(const ALine: string);
    procedure ParseTextStr(const Value: string);
    function GetLine(i:integer): string;
    function ObjCreate(const ALine: string): TPersistent; virtual;
  public
    function ObjAdd(const AValue:string; var AObj: TPersistent): integer;
    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(const ALine: string): TPersistent;
begin
  Result := TPersistent.Create;
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 + #9 + 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 + #9 + v;
    inc(j);
  end;
end;

procedure TObjStringList.AddHeader(const ALine: string);
var
  w, l: string;
  i: integer;
begin
  l := ALine;
  i := 0;
  while ExtractWord([#9], 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;
  i: integer;
  p: TPersistent;
  s: string;
begin
  {winutl}
  l := ALine;
  i := 0;
  p := ObjCreate(ALine);
  while ExtractWord([#9], w, l) do begin
    if i = 0 then
      s := w
    else begin
      if ClassSetPropStr(p, i - 1, w) = 0 then
        break;
    end;
    inc(i);
  end;
  AddObject(s, p);
end;

function TObjStringList.ObjAdd(const AValue:string; var AObj: TPersistent): integer;
begin
  AObj := ObjCreate(AValue);
  Result := AddObject(AValue, 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.
