DelFusa Blog 総本山

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

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

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

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

≫ EDIT

進化した、本当の、TStringListのシンプルな代替



 お届けもので~す!
  ̄ ̄ ̄V ̄ ̄ ̄
    ______
   [__l二l|__
   ミ ;゚Д゚彡__
   ミ | ̄| ̄ ̄|
   ミ O__| メロン| 
   し'` J ̄ ̄



奥さん!いいのが届きましたよ!

今日は、俺からみなさまへ、夏のお歳暮です。
Delphi2007での対応です。


名字も間違ってさらしてしまったので、見なかった事にしてもらうための口止め料です。
MADIAさんところにメールはしたんだけれどもな…消してもらえるのじゃろか?

さて。
前回の、require / ensure は楽しんでいただけましたでしょうか?


ちょっと話題の少ないかもな Delphi界のカンフル剤にでもしていただけたらと思う次第です。
その、ensure の 偽 old オブジェクト (エヴァ的にいうと ダミーオールドシステム)

これを作った時に引き続き、思いついてしまいまいました。


『なんだ、こうすればいいいんだ!』

アイデアが溢れんばかりに出てきてしまうのですが、我ながら才能が恐ろしいです。今更やり方を思いついてしまえば、なんとまあ、簡単な事でしたでしょうか。

以前、某所RANさんに、『華麗な連携』という事を言わしめた、例のメソッドを持つ事のできる新型のrecord型を使った、TStringListRecordの実装についてです。

DelFusaBlog 感動してもろた。
http://delfusa.blog65.fc2.com/blog-entry-123.html

某所 - 華麗な連係プレイに感動
http://bousyo.blog45.fc2.com/blog-entry-243.html

Delphiテクニック - TStringListのシンプルな代替
http://edn.embarcadero.com/article/33623


華麗な連携というのは、フィールド初期化できないというrecord型の腐れ仕様が、TWCさんと、YTさんによって、見事に解決してもらっていた件です。


結局のところ、その解決方法は私にはちょっぴり理解が難しかったりしたりしたので、実装しなかったんですよね。TStringListRecord。なんだかそのrecord型の初期化ができたとしても、その後の実装に、さらに手間もかかりそうだったのです。


実際、私の場合、基本的には、DelFusaライブラリに載せている、TList系のジェネリクスをつかわないバージョンの、TWideStringRecordListなる実装のほうが改行コード周りの使い勝手がよいので、そちらを使っています。

TemplateList
http://delfusa.main.jp/delfusafloor/opensource/delfusalibrary/20070828160200/TemplateList/index.html



VCLのrecord型の初期化と破棄タイミングがわからないという件ですが、この腐れ仕様のせいで、TStringListRecord以外にも、進化したRecord型を、いっこうに使う気がおきません。使う場面が難しいです。


ということで、TStringListRecordなるものは、完全に忘れてしまいたいところです。
いまから、私が永久に忘却させてあげます。

CodeGearの元記事には、このように書かれていました。

  procedure Button1Click…
  var
   SL: TStringListRecord;
  begin
   SL.LoadFromFile(ファイル名);
   //処理
  end;

TStringListそのままだと、Createとして、try finallyに囲うから大変で、みんなも嫌気がさしただろう。そういう事でのrecord型でのTStringListを作ってしまうという提案でした。

では、俺が新しく提案しましょう。100倍くらいにエレガントに。

もはや、StringListについて、varで、変数宣言するのすら面倒です。

こんな風に書いてしまいます。

  procedure Button1Click…
  begin
   StringListObject.LoadFromFile(ファイル名);
   //処理
  end;

この、StringListObject実装で、フル機能のStringListが使えます。

こいつはシングルトンだと思うでしょ。そうそうシングルトンなんですよ。

しかし、StringListを単独で使えるだけだと何にも意味をなさないですよね。

Index指定ありのシングルトンです。引数ありでも動作します。

  StringListObject(整数値)

このように使えば、宣言と同時に、いきなり生成され、もちろんいくつでも作れます。
引数を指定しない場合は、デフォルトで、0が指定されています。

Index付きプロパティで、複数クラス管理した方ならだいたい、実装方法は、想像できましたか?なかなか使いやすいかもでしょ。



でも、さらに考えていくと、名前がStringListObjectだと、何の目的で使うのかわかりにくいです。

例えば、var AddressList: TStringList;

このように使うのが便利。StringListObjectのように番号だけで管理されたStringListはちょっぴり嫌ですよね。
列挙型で数値を指定すればいいとかっていうアイデアもありますが、もっと斜め右の後ろ前が、上下に展開するような、応用を利かせてみましょう。

  StringListObject('名前')

でも、生成され、即使用可能です。
つまり、

  StringListObject('Address').LoadFromFile();

という事が宣言なしに使えます。

文字列を新しい名前にすれば、新しいTStringListオブジェクトが生成されます。

使ったあとは、メモリが気になれば、StringListObject().Clearくらいはしておいてもいいですし
.FreeももちろんOKです。

では、実装です。


////////////////////////////////////////
unit StringListObjectUnit;

interface

uses
 SysUtils,
 Classes,
end_uses;

type
 TStringListObject = class(TStringList)
 private

 protected

 public
  destructor Destroy; override;
  class function ArrayLength: Integer;
  class procedure ArrayClear;
 published

 end;

type TStringList_T = TStringListObject;

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

//テストの為にinterfaceで宣言
//type TStringListArray = array of TStringList_T;
//var uStringListObject: TStringListArray;

implementation

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

{---------------------------------------
  配列を縮小リサイズする関数
機能: uStringListObjectの後方からnilの部分について
    リサイズしてnilじゃない所までサイズを小さくする
備考:
履歴: 2010/07/02(金)
    ・ 作成
}//(*-----------------------------------
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(Name: String): TStringList_T;
var
 Index: Integer;
begin
 if Name = '' then
  raise ERangeError.Create(
   'Range Over StringListObject('')' );

 if NameTable.IndexOfName(Name) = -1 then
  NameTable.Values[Name] := IntToStr(Length(uStringListObject));
{----------------------------------------
  Nameでアクセスする方法は
  最も手っ取り早く重複チェックして代入できるやり方

  Nameの登録がない場合は配列の最後にIndexを指定してそれでアクセス
  Nameの登録がある場合はそのIndexでアクセスしてもらう。
//----------------------------------------}

 Index := StrToInt( NameTable.Values[Name] );

 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(Index: Integer = 0): TStringList_T;
begin
 Result := StringListObject(IntToStr(Index));
end;

{ TStringListObject }

destructor TStringListObject.Destroy;
var
 I: Integer;
 J: Integer;
begin
 for I := 0 to System.Length(uStringListObject) - 1 do
 begin
  if uStringListObject[I] = Self then
  begin
   uStringListObject[I] := nil;

   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;

   AutoReductionReSize(uStringListObject);
   break;
  end;
 end;

 inherited Destroy;
end;

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

class procedure TStringListObject.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.
////////////////////////////////////////

これで、使えます。

Index指定の場合に、必ず新しいStringListObjectを使いたい場合は

  StringListObject(TStringListObject.ArrayLength).Text;

として使ってください。

ん?TStringListではなく、継承したTStringListObjectっていうクラスなのが気になりますか?かっこわるい?

いやいや、あえてこうやっています。

純粋に、StringListObjectが、TStringListである実装をするには
次のように改良してください。
簡単です。

TStringListObjectの宣言部分を、

  type
   TStringListHelper = class helper for TStringList
   private
   protected

   public
    procedure Free;
    class function ArrayLength: Integer;
    class procedure ArrayClear;
   published

   end;

  type TStringList_T = TStringList;

このように変えて、あとは2,3行、コンパイルが通るように修正ください。
TStringListObjectではなく、純粋な、TStringListを返す、StringListObjectの完成です。

クラスヘルパーを使わずに、関数ベースで実装もできますし、そうすればクラスヘルパー非対応時代のDelphi(D7以前か?)でも使えますが、まあ、よいとしましょう。

ユニットをStringListObjectUnit.pasをusesしておくだけで、

何の前提もなく、こんな書き方ができます。
  proceddure TForm1.Button1Click…
  begin
   StringListObject('データ').LoadFromFile(ファイル名);
   StringListObject('データ').Sort;
   StringListObject('データ').SaveToFile(ファイル名);
   StringListObject.Free;
  end;

もはや、Delphiソースとは思えないソースの書き方を、実現してしまいました。
上手に使ってやってください。

こんな風に短縮名を用意してもいいかもね。

  function StrListObj(Index: Integer = 0): TStringListX; overload;
  begin
   Result := StringListObject(Index);
  end;

  function StrListObj(Name: String): TStringListX; overload;
  begin
   Result := StringListObject(Name);
  end;

ということで、「進化した、本当の、TStringListのシンプルな代替 」のお中元でした。

じゃ、

    ______   アリアトザイマスター
   [__l二l|__  シツレーシアース
   ミ ;゚Д゚ミ∩
   ミ ,,O  ミ 
   ミ  ,,,  ミ
   し' `J    

スポンサーサイト

| 未分類 | 12:20 | comments:0 | trackbacks(-) | TOP↑

COMMENT















非公開コメント

PREV | PAGE-SELECT | NEXT

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