DelFusa Blog 総本山

プログラミングの話題とかです。

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

| スポンサー広告 | --:-- | comments(-) | trackbacks(-) | TOP↑

≫ EDIT

さらに進化した、TStringListのシンプルな代替

インターフェースを利用した自動破棄で代替できると噂のStringListObject。別に前方宣言をしなくてよいというメリットだけなのかどうかは、自分で判断してくれよな的な。

そんな話題をかっさらう、StringListObjectの改良型です。


         ┌―――――┐
        / /^/ /^/ /^
      ./ / i/ / i ./ i
      | ( ゚Д゚)( ゚Д゚)( ゚Д゚) <どうも、房ギコです。
      |(ノi  |)i   |)i  |)
      \_ヽ_,ゝ_,ゝ _,ゝ
        U" UU" U U" U 

                改良進化しときました。




前のStringListObjectは、文字列でも数値でも完全ユニークでしたが、
そうすると文字列を忘れてしまうと行方不明になってしまいますので、
ループして全StringListObjectをチェックするということができるようにしておきました。

文字列でアクセスしたStringListObjectに対して
配列のIndex(ArrayIndex)を求める事ができ、そのIndexでアクセスすることもできて
ArrayLengthで指定してループして
ArrayIndexをみることもできます。

ArrayIndexNameプロパティで、Indexでアクセスしたオブジェクトの文字列アクセスの
名称Indexも知ることができるようにしておきました。


クラスヘルパー版の実装です。
純生のStringListを返します。

数行変えたら、継承型のTStringListOject版が作れます。必要な人は作ってね。



────────────────────
unit StringListObjectCHUnit;

interface

uses
 SysUtils,
 Classes,
end_uses;

type
 TStringListHelper = class helper for TStringList
 private

 protected

 public
  procedure Free;
  class function ArrayLength: Integer;
  class procedure ArrayClear;
  function ArrayIndex: Integer;
  function ArrayIndexName: String;
 published

 end;

type TStringList_T = TStringList;

type TStringListObjectFlag = (sfObjectAutoCreate, sfArrayAccess);

function StringListObject(Index: Integer = 0;
Flag: TStringListObjectFlag = sfObjectAutoCreate): TStringList_T; overload;
function StringListObject(Name: String): TStringList_T; overload;

implementation

type TStringListArray = array of TStringList_T;
var uStringListObject: TStringListArray;

procedure AutoReductionReSize(var StringListArray: TStringListArray);
var
 I: Integer;
 NewLength: Integer;
begin
 NewLength := 0;
 for I := System.Length(StringListArray) - 1 downto 0 do
 begin
  if StringListArray[I] <> nil then
  begin
   NewLength := I + 1;
   break;
  end;
 end;

 SetLength(StringListArray, NewLength);
end;

var
 uNameTable: TStringList;

function NameTable: TStringList;
begin
 if not Assigned(uNameTable) then
  uNameTable := TStringList.Create;
 Result := uNameTable;
end;

function StringListObject(Index: Integer = 0;
Flag: TStringListObjectFlag = sfObjectAutoCreate): TStringList_T;
begin
 if Index < 0 then
  raise ERangeError.Create(
   Format('Error:Range Over StringListObject(%d)', [Index]) );

 if Flag = sfArrayAccess then
 begin
  if Length(uStringListObject) <= Index then
   raise ERangeError.Create(
    Format('Error:Range Over StringListObject(%d)', [Index]) );

  Result := uStringListObject[Index];
  Exit;
 end;

 if not (Index <= System.Length(uStringListObject) - 1) then
 begin
  SetLength(uStringListObject, Index + 1);
{----------------------------------------
//SetLengthによってnilは自動で代入されるので、
//下記のように自分で入れる必要はない

  OldLength := Length(uStringListObject);
  SetLength(uStringListObject, Index + 1);
  for I := OldLength to Length(uStringListObject) - 1 do
   uStringListObject[I] := nil
//----------------------------------------}
 end;

 if uStringListObject[Index] = nil then
 begin
  uStringListObject[Index] := TStringList_T.Create;
 end;

 Result := uStringListObject[Index];
end;

function StringListObject(Name: String): TStringList_T;
begin
 if Name = '' then
  raise ERangeError.Create(
   'Error:Range Over StringListObject('')' );

 if NameTable.IndexOfName(Name) = -1 then
  NameTable.Values[Name] := IntToStr(Length(uStringListObject));

 Result := StringListObject( StrToInt(NameTable.Values[Name]) );
end;

{ TStringListHelper }

procedure TStringListHelper.Free;
var
 I: Integer;
 J: Integer;
begin
 I := Self.ArrayIndex;
 if I <> -1 then
 begin
  uStringListObject[I] := nil;
  AutoReductionReSize(uStringListObject);

  for J := 0 to NameTable.Count - 1 do
  begin
   if IntToStr(I) = NameTable.Values[ NameTable.Names[J] ] then
   begin
    NameTable.Delete(J);
    break;
   end;
  end;
 end;

 inherited Free;
end;

function TStringListHelper.ArrayIndex: Integer;
var
 I: Integer;
begin
 Result := -1;
 for I := 0 to System.Length(uStringListObject) - 1 do
 begin
  if uStringListObject[I] = Self then
  begin
   Result := I;
   break;
  end;
 end;
end;


function TStringListHelper.ArrayIndexName: String;
var
 I: Integer;
 J: Integer;
begin
 Result := '';
 for I := 0 to System.Length(uStringListObject) - 1 do
 begin
  if uStringListObject[I] = Self then
  begin
   for J := 0 to uNameTable.Count - 1 do
   with uNameTable do
   begin
    if ValueFromIndex[J] = IntToStr(I) then
    begin
     Result := Names[J];
     break;
    end;
   end;

   break;
  end;

 end;

// Assert(Result = '', 'Error:ArrayIndexName=EmptyStr');
end;


class function TStringListHelper.ArrayLength: Integer;
begin
 Result := System.Length(uStringListObject);
end;

class procedure TStringListHelper.ArrayClear;
var
 I: Integer;
begin
 for I := System.Length(uStringListObject) - 1 downto 0 do
 begin
  {↓リサイズされてIndexが無くなる場合があるのでcontinueしている}
  if Length(uStringListObject) - 1 < I then continue;
  uStringListObject[I].Free;
 end;

 Assert(NameTable.Count = 0, 'Error:NameTable.Count <> 0');
 Assert(Length(uStringListObject) = 0, 'Error:Length(uStringListObject) <> 0');
end;

initialization
 SetLength(uStringListObject, 0);
 uNameTable := nil;

finalization
 TStringList_T.ArrayClear;

 uNameTable.Free;
end.
────────────────────

テストコードも掲載しておきます。

unit testStringListObjectUnit;

interface

uses SysUtils, XPtest;

procedure testStringListObject;
procedure testStrListObj;

implementation

//uses StringListObjectUnit; type TStringListX = TStringListObject;
uses Classes, StringListObjectCHUnit; type TStringListX = TStringList;


procedure testStringListObject;
var
 I: Integer;
 s: String;
 str: String;
begin
 TStringListX.ArrayClear;

 Check(0, TStringListX.ArrayLength);
 StringListObject(2).Add('123');
 StringListObject(2).Add('456');
 StringListObject(2).Add('789');
 Check(3, TStringListX.ArrayLength);

 Check('123', StringListObject(2)[0]);

 StringListObject(4).Text := StringListObject(2).Text;
 Check('789', StringListObject(4)[2]);
 Check(5, TStringListX.ArrayLength);

 {↓文字でアクセスした場合は配列の最後に追加される}
 StringListObject('test').Add('ABC');
 Check(6, TStringListX.ArrayLength);
 Check('ABC', StringListObject('test')[0]);

 {↓大小文字は区別せずにアクセスされる}
 Check(True, StringListObject('test') = StringListObject('TeSt'));

 {↓自動的にリサイズされサイズ=ArrayLengthが縮む}
 Check(6, TStringListX.ArrayLength);
 StringListObject('TEST').Free;
 Check(5, TStringListX.ArrayLength);

 {↓文字列で指定すると新たに配列が増える}
 StringListObject('abc'); // 2 4 abc
 StringListObject('def'); // 2 4 abc def
 StringListObject('ghi'); // 2 4 abc def ghi
 Check(8, TStringListX.ArrayLength);

 {↓途中を破棄しても配列要素数は変わらない}
 StringListObject('def').Free; // 2 4 abc ghi
 Check(8, TStringListX.ArrayLength);

 {↓違う文字だと配列は増える}
 StringListObject('jkl'); // 2 4 abc ghi jkl
 Check(9, TStringListX.ArrayLength);

 StringListObject('jkl').Free; // 2 4 abc ghi
 Check(8, TStringListX.ArrayLength);
 {↓自動的にリサイズされサイズ=ArrayLengthが縮む}
 StringListObject('ghi').Free; // 2 4 abc
 Check(6, TStringListX.ArrayLength);


 StringListObject('abc').Free; // 2 4
 Check(5, TStringListX.ArrayLength);

 //一度削除したタイトルはもう一度使うと新しい番号で使われる
 StringListObject('ghi'); // 2 4 ghi
 Check(6, TStringListX.ArrayLength);

 StringListObject('あ');
 StringListObject('い').Text := 'A'#13#10'B'#13#10'C';
 StringListObject('う');
 StringListObject('え');
 StringListObject('お'); // 2 4 ghi あ い う え お
 Check(11, TStringListX.ArrayLength);
 Check('B', StringListObject('い').Strings[1]);

 Check(6, StringListObject('あ').ArrayIndex);
 Check('ghi', StringListObject(5).ArrayIndexName);

 S := '';
 for I := 0 to TStringListX.ArrayLength - 1 do
 begin
  if StringListObject(I, sfArrayAccess) = nil then
   S := S + ''
  else
  begin
   str := StringListObject(I).ArrayIndexName;
   if str = '' then
    S := S + IntToStr(StringListObject(I).ArrayIndex)
   else
    S := S + str;

  end;
  S := S + ' ';
 end;
 Check(' 2 4 ghi あ い う え お ', S);

end;

end.
────────────────────
スポンサーサイト

| 未分類 | 23:33 | comments:0 | trackbacks(-) | TOP↑

COMMENT















非公開コメント

PREV | PAGE-SELECT | NEXT

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。