TMultiStringList＆amp;字符串列表

时间：2012-12-17 13:03:50

标签： delphi delphi-xe2

我最近发现了这个代码并且我一直试图修改它但是没有运气..如何修改代码以便它接受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.

2 个答案:

答案 0 :(得分：3)

也许是这样的？

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;

答案 1 :(得分：1)

这是一个选项。

首先添加一个方法来处理string变量中提供的输入。签名如下所示：

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

我们稍后会来实施。接下来添加一些依赖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;

最后，我们可以实现完成所有实际工作的方法。我从您的问题中获取了代码，并将LoadFromFile()替换为Text := ...。结果如下：

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;

写完这一切之后，我会评论说Uwe的方法更好。它使用完全相同的基本思想。将执行工作的代码放在一个方法中，并添加额外的适配器方法以支持来自不同源的输入。

我认为Uwe的方法更好的原因是它减少了创建的临时字符串列表的数量。在这方面，Uwe的方式更好。如果你想为Uwe的答案添加LoadFromText，那很简单：

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;
相关问题
最新问题