delphi - TMultiStringList 和 TString

Question

我最近发现了这段代码，我一直在尝试修改它，但没有运气。我如何修改代码，以便它不仅接受文件，还接受 TStrings？

只能这样使用

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

但不是这样的

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

来源:

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.

Answer 1

也许像这样？

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;