この発言は
#00718　佐藤　充男　　　さんのTStringListの拡張
に対するコメントです

この発言に対し以下のコメントが寄せられています

#00728　佐藤　充男　　　さん　RE^2:TStringListの拡張




#718 自己レス




☆説明
　TStringListExのLoadFromStreamを改良して省メモリで動作するようにしま
　した。また、読みこみ途中でイベント発生するのでプログレスバーに途中
　経過を表示することもできます。


☆準備
　nifty:FDELPHI/MES/16/718　のコードを以下のソースのように修正してくだ
　さい。

☆補足
　・Delphi3.1 でのみテスト(^^;
　・ユニットとして修正しました。
　・nifty:FDELPHI/MES/16/629　本田勝彦さんのサンプルを見て機能を拡張
　　しました。有用なサンプルありがとうございます(^^)/


[サンプルソース：StrLstEx.pas]
----------------------------------------------------------------------
unit StrLstEx;

interface

uses
  Classes;

type
  { TStringListEx }
  TLoadingEvent =
    procedure(Sender: TObject; Total, Loaded: Integer) of object;

  TStringListEx = class(TStringList)
  private
    FOnLoading: TLoadingEvent;
  protected
    function GetTextStr: string; override;
    procedure SetTextStr(const Value: string); override;
  public
    procedure LoadFromStream(Stream: TStream); override;

    property OnLoading: TLoadingEvent read FOnLoading write FOnLoading;
  end;

implementation

{ TStringListEx }
function TStringListEx.GetTextStr: string;
var
  I, L, Size, Count: Integer;
  P: PChar;
  S: string;
begin
  Count := GetCount;
  Size := 0;
  for I := 0 to Count - 1 do Inc(Size, Length(Get(I)));
  SetString(Result, nil, Size);
  P := Pointer(Result);
  for I := 0 to Count - 1 do
  begin
    S := Get(I);
    L := Length(S);
    if L <> 0 then
    begin
      System.Move(Pointer(S)^, P^, L);
      Inc(P, L);
    end;
  end;
end;

// 文字列分割
procedure TStringListEx.SetTextStr(const Value: string);
var
  P, Start: PChar;
  S: string;
begin
  BeginUpdate;
  try
    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);
        if ( P^ = #13 ) and ( (P+1)^ = #10 ) then Inc(P, 2)
        else
        begin
          if P^ = #13 then Inc(P);
          if P^ = #10 then Inc(P);
        end;
        SetString(S, Start, P - Start);
        Add(S);
      end;
  finally
    EndUpdate;
  end;
end;

// ストリームから読み込み
procedure TStringListEx.LoadFromStream(Stream: TStream);
const
  BufferSize = $2000;
var
  ReadSize, TotalSize, LoadingSize: Integer;
  ReadBuf: array[0..BufferSize+1] of Char;
  Str, WStr: string;
  P, Start: PChar;
begin
  BeginUpdate;
  try
    TotalSize := Stream.Size - Stream.Position;
    LoadingSize := 0;

    FillChar(ReadBuf, BufferSize + 1, #0);
    P := ReadBuf;
    Str := '';
    Start := P;
    repeat
      ReadSize := Stream.Read(P^, BufferSize);
      LoadingSize := LoadingSize + ReadSize;
      if Assigned(FOnLoading) then
        FOnLoading(Self, TotalSize, LoadingSize);

      if ReadSize > 0 then
      begin
        repeat
          while not (P^ in [#0, #10, #13]) do Inc(P);
          if ( P^ = #13 ) and ( (P+1)^ = #10 ) then
            Inc(P, 2)
          else
          begin
            if P^ = #13 then Inc(P);
            if P^ = #10 then Inc(P);
          end;

          SetString(WStr, Start, P - Start);
          Str := Str + WStr;
          if P^ = #0 then
          begin
            FillChar(ReadBuf, BufferSize + 1, #0);
            P := ReadBuf;
            Start := P;
            Break;
          end;

          Add(Str);
          Str := '';
          Start := P;
        until P^ = #0;
      end;
    until ReadSize = 0;

    if Length(Str) > 0 then
      Add(Str);
    if Assigned(FOnLoading) then
      FOnLoading(Self, TotalSize, LoadingSize);
  finally
    EndUpdate;
  end;
end;

end.
----------------------------------------------------------------------

［使い方］
Unit1.pasのuses節に'StrLstEx'を追加し、OnLoading イベント用procedure
のStrLstExOnLoading(...) を追加してください。
----------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
  strlst: TStringListEx;
begin
  strlst := TStringListEx.Create;
  strlst.OnLoading := StrLstExOnLoading;

  ProgressBar1.Position := 0;
  ProgressBar1.Update;

  strlst.LoadFromFile('Test.txt');
  strlst.OnLoading := nil;

  strlst.SaveToFile('Test01.txt');
  strlst.Free;
end;

procedure TForm1.StrLstExOnLoading(Sender: TObject; Total, Loaded: Integer);
begin
  ProgressBar1.Position := Trunc(Loaded / Total * 100);
  ProgressBar1.Update;
end;
----------------------------------------------------------------------

                              98/11/11(水) 05:02pm  LDM03756 佐藤　充男

Original document by 佐藤　充男　　　氏 ID:(LDM03756)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。