CODEWITHSUNDEEP
delphidelphi-xe2
Santos Oliveira
Santos Oliveira

Reputation: 497

TMultiStringList & TStrings

I found this code recently and i've been trying to modify it however without luck.. How can I modify the code so that it will accept TStrings aswell not just File?

It can only be used in such way

TMultiStringList.LoadFromFile('somefile.txt',
 TMultiStringList.TFill.mfiClearBeforeFill,
 TMultiStringList.TMode.mslSpread);

but not like this

TMultiStringList.LoadFromStrings(StringList.Text,
 TMultiStringList.TFill.mfiClearBeforeFill,
 TMultiStringList.TMode.mslSpread);

The source:

unit Multi;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Generics.Collections;

type
  TMultiStringList = class
  public
    type
      TFill = (mfiAdd, mfiClearBeforeFill);

      TMode = (
        mslTrim,        // Trim lines before add
        mslLower,       // Lower lines before add
        mslUpper,       // Upper lines before add
        mslAssign,      // Just use Assign()
        mslSpread);     // Spread text to the lists
  private
    FLength: Integer;
    FLists: TArray<TStringList>;
    function ValidArray(): Boolean;
    procedure BuildArray(const Length: Integer);
    procedure FreeArray();
    function GetList(const Index: Integer): TStringList;
  public
    constructor Create(const Length: Integer);
    destructor Destroy(); override;
    procedure LoadFromFile(const FileName: string; const Fill: TFill; const Mode: TMode);
    property ListCount: Integer read FLength;
    property Lists[const Index: Integer]: TStringList read GetList;
  end;

implementation

{ TMultiStringList }

procedure TMultiStringList.BuildArray(const Length: Integer);
var
  I: Integer;
begin
  SetLength(FLists, Length);
  for I := Low(FLists) to High(FLists) do
    FLists[I] := TStringList.Create();
end;

constructor TMultiStringList.Create(const Length: Integer);
begin
  FLength := Length;
  BuildArray(Length);
end;

destructor TMultiStringList.Destroy;
begin
  FreeArray();
  inherited;
end;

procedure TMultiStringList.FreeArray;
var
  I: Integer;
begin
  if (Length(FLists) > 0) then
  begin
    for I := Low(FLists) to High(FLists) do
    begin
      FLists[I].Free();
      FLists[I] := nil;
    end;
    SetLength(FLists, 0);
  end;
end;

function TMultiStringList.GetList(const Index: Integer): TStringList;
begin
  Result := FLists[Index];
end;
procedure TMultiStringList.LoadFromFile(const FileName: string; const Fill: TFill; const Mode: TMode);

  procedure HandleLoad(Callback: TProc<TStringList, string>);
  var
    List, Target: TStringList;
    I, J: Integer;
  begin
    List := TStringList.Create();
    try
      List.LoadFromFile(FileName);
      for I := Low(FLists) to High(FLists) do
      begin
        if (Fill = TFill.mfiClearBeforeFill) then
          FLists[I].Clear();

        for J := 0 to List.Count - 1 do
          Callback(FLists[I], List[J]);
      end;
    finally
      List.Free();
    end;
  end;

  procedure HandleAssign();
  var
    I: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
      FLists[0].Clear();

    FLists[0].LoadFromFile(FileName);

    for I := 1 to High(FLists) do
    begin
      if (Fill = TFill.mfiClearBeforeFill) then
        FLists[I].Clear();

      FLists[I].Assign(FLists[0]);
    end;
  end;

  procedure HandleSpread();
  var
    List: TStringList;
    I: Integer;
    ItemsPerList: Integer;
    ListIndex: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
    begin
      for I := Low(FLists) to High(FLists) do
        FLists[I].Clear();
    end;

    List := TStringList.Create();
    try
      List.LoadFromFile(FileName);

      ItemsPerList := (List.Count + FLength - 1) div FLength;

      for I := 0 to List.Count - 1 do
      begin
        FLists[I div ItemsPerList].Add(List[I]);
      end;
    finally
      List.Free();
    end;
  end;

begin
  if (not ValidArray()) then
    raise Exception.Create('Array incomplete!');

  case Mode of
    mslTrim : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(Trim(S));
                     end);

    mslLower     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(LowerCase(S));
                     end);

    mslUpper     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(UpperCase(S));
                     end);

    mslAssign    : HandleAssign();

    mslSpread    : HandleSpread();
  else
    raise ENotImplemented.Create('Mode not implemented!');
  end;
end;


function TMultiStringList.ValidArray: Boolean;
begin
  Result := Length(FLists) = FLength;
end;

end.

Upvotes: 1

Views: 654

Answers (2)

David Heffernan
David Heffernan

Reputation: 613572

Here's one option.

First of all add a method to process input supplied in a string variable. The signature looks like this:

procedure LoadFromText(const Text: string; const Fill: TFill;
  const Mode: TMode);

We will come to the implementation later. Next add a couple of methods that rely on LoadFromText:

procedure TMultiStringList.LoadFromFile(const FileName: string; 
  const Fill: TFill; const Mode: TMode);
var
  Strings: TStringList;
  Text: string;
begin
  Strings := TStringList.Create;
  try
    Strings.LoadFromFile(FileName);
    Text := Strings.Text;
  finally
    Strings.Free;
  end;
  LoadFromText(Text, Fill, Mode);
end;

procedure TMultiStringList.LoadFromStrings(Strings: TStrings; 
  const Fill: TFill; const Mode: TMode);
begin
  LoadFromText(Strings.Text, Fill, Mode);
end;

Finally we can implement the method that does all the real work. I've taken the code from your question and replaced LoadFromFile() with Text := .... The result looks like this:

procedure TMultiStringList.LoadFromText(const Text: string; 
  const Fill: TFill; const Mode: TMode);

  procedure HandleLoad(Callback: TProc<TStringList, string>);
  var
    List, Target: TStringList;
    I, J: Integer;
  begin
    List := TStringList.Create();
    try
      List.Text := Text;
      for I := Low(FLists) to High(FLists) do
      begin
        if (Fill = TFill.mfiClearBeforeFill) then
          FLists[I].Clear();

        for J := 0 to List.Count - 1 do
          Callback(FLists[I], List[J]);
      end;
    finally
      List.Free();
    end;
  end;

  procedure HandleAssign();
  var
    I: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
      FLists[0].Clear();

    FLists[0].Text := Text;

    for I := 1 to High(FLists) do
    begin
      if (Fill = TFill.mfiClearBeforeFill) then
        FLists[I].Clear();

      FLists[I].Assign(FLists[0]);
    end;
  end;

  procedure HandleSpread();
  var
    List: TStringList;
    I: Integer;
    ItemsPerList: Integer;
    ListIndex: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
    begin
      for I := Low(FLists) to High(FLists) do
        FLists[I].Clear();
    end;

    List := TStringList.Create();
    try
      List.Text := Text;

      ItemsPerList := (List.Count + FLength - 1) div FLength;

      for I := 0 to List.Count - 1 do
      begin
        FLists[I div ItemsPerList].Add(List[I]);
      end;
    finally
      List.Free();
    end;
  end;

begin
  if (not ValidArray()) then
    raise Exception.Create('Array incomplete!');

  case Mode of
    mslTrim : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(Trim(S));
                     end);

    mslLower     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(LowerCase(S));
                     end);

    mslUpper     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(UpperCase(S));
                     end);

    mslAssign    : HandleAssign();

    mslSpread    : HandleSpread();
  else
    raise ENotImplemented.Create('Mode not implemented!');
  end;
end;

Having written all this, I would comment that Uwe's approach is better. It uses exactly the same basic idea. Put the code that does the work in one method and add extra adapter methods to support input from varying sources.

The reason that I think Uwe's approach is better is that it reduces the number of temporary string lists that are created. The way Uwe slices it up is better in that regard. And if you want to add a LoadFromText to Uwe's answer that is simple:

procedure TMultiStringList.LoadFromText(const Text: string; 
  const Fill: TFill; const Mode: TMode);
var
  Strings: TStringList;
begin
  Strings := TStringList.Create;
  try
    Strings.Text := Text;
    LoadFromStrings(Strings, Fill, Mode);
  finally
    Strings.Free;
  end;
end;

Upvotes: 1

Uwe Raabe
Uwe Raabe

Reputation: 47889

Perhaps like this?

procedure TMultiStringList.LoadFromFile(const FileName: string; const Fill: TFill; const Mode: TMode);
var
  list: TStringList;
begin
  list := TStringList.Create;
  try
    list.LoadFromFile(FileName);
    LoadFromStrings(list, Fill, Mode);
  finally
    list.Free;
  end;
end;

procedure TMultiStringList.LoadFromStrings(Source: TStrings; const Fill: TFill; const Mode: TMode);

  procedure HandleLoad(Callback: TProc<TStringList, string>);
  var
    list: TStringList;
    line: string;
  begin
    for list in FLists do
    begin
      if (Fill = TFill.mfiClearBeforeFill) then
        list.Clear();

      for line in Source do
        Callback(list, line);
    end;
  end;

  procedure HandleAssign();
  var
    I: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
      FLists[0].Clear();

    FLists[0].AddStrings(Source);

    for I := 1 to High(FLists) do
    begin
      if (Fill = TFill.mfiClearBeforeFill) then
        FLists[I].Clear();

      FLists[I].Assign(FLists[0]);
    end;
  end;

  procedure HandleSpread();
  var
    list: TStringList;
    I: Integer;
    ItemsPerList: Integer;
  begin
    if (Fill = TFill.mfiClearBeforeFill) then
    begin
      for list in FLists do
        list.Clear();
    end;

    ItemsPerList := (Source.Count + FLength - 1) div FLength;

    for I := 0 to Source.Count - 1 do
    begin
      FLists[I div ItemsPerList].Add(Source[I]);
    end;
  end;

begin
  if (not ValidArray()) then
    raise Exception.Create('Array incomplete!');

  case Mode of
    mslTrim : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(Trim(S));
                     end);

    mslLower     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(LowerCase(S));
                     end);

    mslUpper     : HandleLoad(
                     procedure(Target: TStringList; S: string)
                     begin
                       Target.Add(UpperCase(S));
                     end);

    mslAssign    : HandleAssign();

    mslSpread    : HandleSpread();
  else
    raise ENotImplemented.Create('Mode not implemented!');
  end;
end;

Upvotes: 3

Related Questions