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

#01110　雪見酒          さん　RE:汎用セパレータを扱うStringList




こんにちは、雪見酒です。

nifty:FDELPHI/MES/6/31418 で話題になった、TStringListの拡張です。
本田勝彦さんに教わった通り、Findを使うValuesプロパティを作ろうかと
思いましたが、ChildListに作業をさせることにしました。
で、Values,GetValue,SetValueを新たに作らずにChildList,SpalatedText
プロパティを追加しました。
DUDEさんのStrTok関数を使っているので、セパレータ、デリミタの自由度が
正規表現ほどではないですが、非常に大きいです。(^^)
使用例は、この下のツリーに。



unit YzStrList;
{Key Delim Value Sep Value... 形式の文字データを扱うクラス }

interface
uses Windows,classes,Dialogs,SysUtils;

type

  TStrTokSeparator = set of Char;

  TStrTokRec = record
    Str:string;
    Pos:Integer;
  end;

  TYzStrList = class(TStringList)
  private
    FDelimiter,FSeparator:TStrTokSeparator;
    FOutSeparator:Char;
    FKey:string;
    FChildList:TStringList;
    FChildSorted:boolean;
    FChildDups:TDuplicates;
    function  StrTokNext(const sep:TStrTokSeparator;
                            var Rec:TStrTokRec;var S:string):string;
    procedure SetList(const Name:string;List:TStringList);
    function  GetList(const Name:String):TStringList;
    procedure SetSpTxt(Index:integer;Value:string);
    function  GetSpTxt(Index:integer):string;
  public
    destructor  Destroy; override;
    function Add(const S: string): Integer;override;
    property Key:string read FKey write FKey;
    property Delimiter:TStrTokSeparator
                              read FDelimiter write FDelimiter;
    property Separator:TStrTokSeparator
                              read FSeparator write FSeparator;
    property OutSparator:Char read FOutSeparator write FOutSeparator;
    property ChildList[const Name:string]:TStringList
                              read GetList write SetList;
    property SeparatedText[Index:integer]:string
                              read GetSpTxt write SetSpTxt;
    property ChildSorted:boolean
                              read FChildSorted write FChildSorted;
    property ChildDuplicates:TDuplicates
                              read FChildDups write FChildDups;
  end;

implementation

function TYzStrList.StrTokNext(const sep:TStrTokSeparator;
                    var Rec:TStrTokRec;var S:string):string;
//これはDUDEさんのtoken切り出し関数 nifty:FDELPHI/MES/16/630
var
  Len, I: Integer;
begin
  with Rec do begin
    Len := Length(Str);
    S:='';Result := '';
    if Len >= Pos then  begin
      while (Pos <= Len) and (Str[Pos] in sep) do begin
       Inc(Pos);
      end;
      I := Pos;
      while (Pos<= Len) and not (Str[Pos] in sep) do begin
        if IsDBCSLeadByte(Byte(Str[Pos])) then begin
          Inc(Pos);
        end;
        Inc(Pos);
      end;
      S := Copy(Str, I, Pos - I); Result:= S;
      while (Pos <= Len) and (Str[Pos] in sep) do begin
        Inc(Pos);
      end;
    end;
  end;
end;

procedure TYzStrList.SetList(const Name:string;List:TStringList);
var
  Index:integer;
begin
  if Find(Name,Index) then begin
    TStringList(Objects[index]).Clear;
    TStringList(Objects[index]).Assign(List);
  end;
end;

function TYzStrList.GetList(const Name:string):TStringList;
var Index:integer;
begin
  result:=nil;
  if Find(Name,Index) then begin
    Result:=TStringList(Objects[index]);
  end;
end;

procedure TYzStrList.SetSpTxt(Index:integer;Value:string);
var
  Rec:TStrTokRec;
  SS:string;
begin
  if Index < Count then begin
    Rec.Pos:=1;
    Rec.Str:=Value;
    TStringList(Objects[Index]).Clear;
    TStringList(Objects[Index]).Sorted:=FChildSorted;
    TStringList(Objects[Index]).Duplicates:=FChildDups;
    while  StrTokNext(FSeparator,Rec,SS) <>'' do
        TStringList(Objects[Index]).Add(SS);
  end;
end;

function TYzStrList.GetSpTxt(Index:integer):string;
var n:integer;
begin
  result := '';
  if TStringList(Objects[index])<>nil then begin
    for n:= 0 to TStringList(Objects[index]).Count-1 do begin
      if n = 0 then result:= TStringList(Objects[index])[n]
      else
result:=result+FOutSeparator+TStringList(Objects[index])[n];
    end;
  end;
end;

destructor TYzStrList.Destroy;
var i:integer;
begin
  for i:= 0 to Count-1 do begin
    TStringList(Objects[i]).Free;
  end;
  inherited Destroy;
end;

function TYzStrList. Add(const S: string): Integer ;
// Duplicates の値で挙動を変える
var
  index:integer;
  S1,SS:string;
  Rec:TStrTokRec;
begin
    Rec.Str := S;
    Rec.Pos :=1;
    StrTokNext(FDelimiter,Rec,S1);
  if (Duplicates=dupIgnore) and Sorted then begin
    if not(Find(S1,index)) then begin
      FChildList:=TStringList.Create;
      while  StrTokNext(FSeparator,Rec,SS) <>'' do begin
        FchildList.Sorted:=FChildSorted;
        FchildList.Duplicates:=FChildDups;
        FChildList.Add(SS);
      end;
      result := inherited Add(S1);
      Objects[result] := FChildList;
    end else begin
      while  StrTokNext(FSeparator,Rec,SS) <>'' do begin
        TStringList(Objects[index]).Add(SS);
      end;
      result:=index
    end;
  end else begin
    result := inherited Add(S1);
    FChildList:=TStringList.Create;
    StrTokNext(FDelimiter,Rec,SS);
    FChildList.Add(SS);
    Objects[result] := FChildList;
  end
end;

end.


                              Yukimi Sake GHE01746@nifty.ne.jp

Original document by 雪見酒          氏 ID:(GHE01746)

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