Objects[]って何だろう

参照元１   参照元２   参照元３   参照元４


redball.gif目次へ戻る

ML や BBS などでもたびたび話題になるオプションプロパティーについて調べよう。Delphi のコンポーネントパレットを見ながら調べたところ、だいたい以下のようなオプションプロパティーがある。

TMenuItem.Tag : LongInt;
TActionList.Actions.Tag : LongInt;

TMemo.Lines.Objects[] : TObject;
TListBox.Items.Objects[] : TObject;
TComboBox.Items.Objects[] : TObject;
TRadioGroup.Items.Objects[] : TObject;
TStringGrid.Objects[] : TObject;
TTabControl.Tabs.Objects[] : TObject;
TRichEdit.Lines.Object[] : TObject;
TListView.Items.Item[].SubItems.Objects[] : TObject;

TTreeView.Items.Item[].Data : Pointer;
TListView.Items.Item[].Data : Pointer;

どれもかなり頻繁に使われるコンポーネントである。コンポーネントパレットに載っているのは、TComponent クラスの派生クラスなので、それ自体に Tag プロパティーがあるが、個別の項目プロパティーの場合とは使用法が異なるのでここでは論じない。上の最初と二番目の Tag プロパティーも TComponent クラスに由来しているが、単独でフォームに載るコンポーネントではなく、各項目のプロパティーであることに注目する。一番多い Objects[] プロパティーは、TStringGrid を除くと Windows のコントロールにそもそも備わっているのに対応した TStrings 派生クラスに由来している。TStringGrid は、対応するウィンドウコントロールはなく、VCL 独自に実装したものであるが、各列、各行の文字列のリストには、Cols と Rows のプロパティーで個々の項目にアクセスできるようになっているので、やはり、Objects[] は TStrings 由来であると言えるだろう。TTreeNode.Data と TListItem.Data は、ウィンドウコントロールとしても対応する LPARAM 型のオプションフィールドがあるが、VCL ではこれを使用しないで独自のプロパティーとして実装されている。

さてこれらの「オプションプロパティー」は、それぞれのコントロールの実装に関与することなく、ユーザが勝手に使ってよいことになっている。ここではこのオプションプロパティーをどのように使用できるか調べてみよう。どのプロパティーも、３２ビットの幅であることを知っておくことは重要である。Objects[] は、TObject 型であり、これはクラスのオブジェクト参照を一つ保存できることを意味しているが、現在の実装ではオブジェクト参照はポインタなので、やはり、３２ビット分の記憶領域しか持たないことを知っておく必要がある。Delphi の TObject はすべてのクラスの上位クラスなので、すべてのクラスのオブジェクト参照を代入できる。そのほか、ポインタであることを知っていると、integer や TColor などの３２ビットまでの数値そのものを記憶できる。オブジェクト参照が３２ビットのポインタと同じであることは、なかなか分かりづらいかも知れない。Delphi を起動して、Form1 に Button1 と Label1 を置いて、以下のようにすると

List 1

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := IntToStr(SizeOf(Button1));
end;

Label1 には、４ と表示される。SizeOf(Form1) でも同じである。このように、クラス（TButton や TForm1）のインスタンスを格納するオブジェクト参照（Button1 や Form1）は、４バイト＝３２ビットのサイズの変数である。各クラスの実際のインスタンスサイズは、TObject の クラスメソッド InstanceSize をつかって求められる。

List 2

procedure TForm1.Button1Click(Sender: TObject);
begin
  Label1.Caption := IntToStr(TButton.InstanceSize);
end;

D5 では、上の場合、５１２と表示される。

[ 整数値を記憶させる ]

当たり前だが、コンピュータで何かを記憶させるためには、メモリやディスクファイルに書き込んでおく必要がある。TObject 型の変数は、それ自体が３２ビットの変数なので型キャストすることにより、このプロパティー自体で３２ビットまでの数値を記憶できる。試してみよう。Form1 に ListBox1 と Label1 を置いて以下のようにする。

List 3

procedure TForm1.FormCreate(Sender: TObject);
begin
  with ListBox1.Items do begin
    AddObject('祖母',TObject(82));
    AddObject('父',TObject(50));
    AddObject('母',TObject(46));
    AddObject('長女',TObject(20));
    AddObject('長男',TObject(18));
    AddObject('次女',TObject(12));
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  indx,toshi:integer;
begin
  indx := ListBox1.ItemIndex;
  toshi := integer(ListBox1.Items.Objects[indx]);
  Label1.Caption := Format('%s の年齢は %d 才です。',[ListBox1.Items[indx],toshi]);
end;
n02301.gif

ここでは、Objects[] に設定するときは TObject(82) のように数値を TObject にキャストして設定し、取り出すときは、integer(ListBox1.Items.Objects[indx]) のようにして、キャストして数値に戻している。



設定するときは、TStrings の以下のメソッドを使った。

function TStrings.AddObject(const S: string; AObject: TObject): Integer; virtual;

これは文字列と Objects[] を同時に設定して追加できる。文字列と Objects[] は個別にも設定できる。

List 4

procedure TForm1.FormCreate(Sender: TObject);
var
  indx:integer;
begin
  with ListBox1.Items do begin
    indx := Add('祖母'); Objects[indx] := TObject(82);
    indx := Add('父'); Objects[indx] := TObject(50);
    indx := Add('母'); Objects[indx] := TObject(46);
    indx := Add('長女'); Objects[indx] := TObject(20);
    indx := Add('長男'); Objects[indx] := TObject(18);
    indx := Add('次女'); Objects[indx] := TObject(12);
  end;
end;

このように、まず、Add('文字列'); で項目を追加し、そのとき返されるインデックス（添え字）を使って、あとで Objects[] を設定することもできる。Objects[] 単独では追加できない。空白でもよいので、文字列を追加して項目を個別に確保する必要がある。Objects[] は、項目に対するオプションである、と考えられる。

この応用として TColor やウィンドウズの色の型 COLORREF 型を Objects[] に記憶させてみよう。色の指定は以下のように３２ビットの数値と等価である。

type
  TColor = -$7FFFFFFF-1..$7FFFFFFF;

type
  COLORREF = DWORD;

ここでは、色の選択ができる ComboBox を作ってみよう。Form1 に Panel1 と ComboBox1 を置いて以下のようにする。

List 5

procedure TForm1.FormCreate(Sender: TObject);
begin
  with ComboBox1.Items do begin
    AddObject('clBlack',TObject(clBlack));
    AddObject('clMaroon',TObject(clMaroon));
    AddObject('clGreen',TObject(clGreen));
    AddObject('clOlive',TObject(clOlive));
    AddObject('clNavy',TObject(clNavy));
    AddObject('clPurple',TObject(clPurple));
    AddObject('clTeal',TObject(clTeal));
    AddObject('clGray',TObject(clGray));
    AddObject('clSilver',TObject(clSilver));
    AddObject('clRed',TObject(clRed));
    AddObject('clLime',TObject(clLime));
    AddObject('clYellow',TObject(clYellow));
    AddObject('clBlue',TObject(clBlue));
    AddObject('clFuchsia',TObject(clFuchsia));
    AddObject('clAqua',TObject(clAqua));
    AddObject('clLtGray',TObject(clLtGray));
    AddObject('clDkGray',TObject(clDkGray));
    AddObject('clWhite',TObject(clWhite));
  end;
  ComboBox1.Style := csOwnerDrawFixed;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  with ComboBox1.Canvas do begin
    Brush.Color := TColor(ComboBox1.Items.Objects[Index]);
    FillRect(Rect);
  end;
end;

procedure TForm1.ComboBox1Click(Sender: TObject);
begin
  Panel1.Color := TColor(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
  Panel1.Caption := ComboBox1.Items[ComboBox1.ItemIndex];
end;
n02302.gif

ここでは、TObject(clBlack) のように TColor 型の値を TObject にキャストして設定し、ComboBox1.Style := csOwnerDrawFixed; で、高さ固定のオーナードローにしている。そして、OnDrawItem イベントハンドラで TColor(ComboBox1.Items.Objects[Index]); のようにして、色の設定を取り出している。



同じようにして、これも FAQ であるが、StringGrid の各セルの背景色や文字の色を別々に設定したい場合、どちらか一つの色なら、Objects[] に記憶させ、OnDrawCell イベントで取り出して、描画に用いることができる。下図は、HTML で使われる色の設定を背景色として設定した例である。

n02303.gif

全コードを以下に示す。

List 6

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Panel1: TPanel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    Edit2: TEdit;
    SpeedButton2: TSpeedButton;
    Edit3: TEdit;
    SpeedButton3: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
  private
    { Private 宣言 }
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i,ACol,ARow:integer;
  Name,Value,CValue:string;
  ret,Clr:integer;
  SL:TStringList;
begin
  with StringGrid1 do begin
    FixedCols := 0;
    FixedRows := 0;
    ColCount := 6;
    DefaultColWidth := 100;
    RowCount := 24;
  end;

  SL := TStringList.Create;
  SL.LoadFromFile(ExtractFilePath(ParamStr(0))+'HTMLColor.txt');
  for i := 0 to SL.Count-1 do begin
    ret := Pos('#',SL[i]);
    Name := Copy(SL[i],1,ret-1);
    Value := Copy(SL[i],ret+1,6);
    CValue := Copy(Value,5,2)+Copy(Value,3,2)+Copy(Value,1,2);
    Clr := StrToInt('$'+CValue);
    ARow := i div 6;
    ACol := i mod 6;
    StringGrid1.Cells[ACol,ARow] := Name;
    StringGrid1.Objects[ACol,ARow] := TObject(Clr);
  end;  
  SL.Free;
end;

function IsColorDark(Clr:integer):Boolean;
var
  Meido:Real;
begin
  Meido := GetRValue(Clr)*0.31+GetGValue(Clr)*0.59+GetBValue(Clr)*0.11;
  result := Meido < 120;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  with StringGrid1 do begin
    Canvas.Brush.Color := TColor(Objects[ACol,ARow]);
    Canvas.FillRect(Rect);
    if IsColorDark(integer(Objects[ACol,ARow])) then
      Canvas.Font.Color := clSilver;
    Canvas.TextOut(Rect.Left+2,Rect.Top+2,Cells[ACol,ARow]);
    Canvas.Brush.Color := clWhite;
  end;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
var
  s:string;
  Clr:TColor;
begin
  s := StringGrid1.Cells[StringGrid1.Col,StringGrid1.Row];
  if Length(s) > 1 then
  begin
    Clr := TColor(StringGrid1.Objects[StringGrid1.Col,StringGrid1.Row]);
    if IsColorDark(integer(Clr)) then
      Panel1.Font.Color := clSilver
    else
      Panel1.Font.Color := clBlack;
    Panel1.Color := Clr;
    Panel1.Caption := s;
    Edit1.Text := s;
    Edit2.Text := Format('$%.6X',[Clr]);
    Edit3.Text := Format('#%.2X%.2X%.2X',
                      [GetRValue(Clr),GetGValue(Clr),GetBValue(Clr)]);
  end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  Edit1.SelectAll;
  Edit1.CopyToClipboard;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  Edit2.SelectAll;
  Edit2.CopyToClipboard;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  Edit3.SelectAll;
  Edit3.CopyToClipboard;
end;

end.

ここでは、各セルの文字列と Objects[] への色の設定は、FormCreate() イベントハンドラで外部のテキストファイルを読み込んで行っている。以下にリンクを示す。

HTMLColor.txt

外部ファイルではなく、exe の中に納めたいときは 005 TPicture と TStringList のカプセル化 か 008 EXE に埋め込む - リソースの使い方 の方法を使って exe に埋め込むことができる。


[ 文字列を関連づける ]

上に述べたように、Objects[] などのオプションプロパティーは、３２ビットの幅の記憶容量しかないので、文字列そのものを記憶することはできない。したがって、どこかに文字列を記憶させる場所を設けなくてはならない。一番簡単なのは、Form1 のフィールドかグローバル変数に TStringList のインスタンスを用意しておき、任意の文字列を追加し、そのインデックスを Objects[] に記憶させることである。これはすぐ前にやった整数値を記憶させることと同じである。取り出すときは、integer にキャストしてインデックスを取得し、StringList にそのインデックスをつかって文字列を取得できる。別な方法として、外部にリストオブジェクトを設けなくても、文字列をメモリに記憶させ、その場所のポインタを取得できればよい。この目的にぴったりな関数がある。

procedure New(var P: Pointer);

procedure Dispose(var P: Pointer);

New() は、任意の型付きポインタ P で指定された型のサイズに対応した動的変数をメモリに確保し、その変数を指すポインタを返す。Dispose() は、New() で割り当てたメモリを解放する。このとき、正しく解放するためには、ポインタの型を正しく指定する必要がある。このペアを使うと、string 型の変数を用意することなく、ポインタで文字列にアクセスできるようになる。やってみよう。最初の例で、年齢ではなく誕生日を文字列として記憶させてみよう。

List 7

function NewStr(s:string):PString;
begin
  New(result);
  result^ := s;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  with ListBox1.Items do begin
    AddObject('祖母',TObject(NewStr('大正１０年３月３日')));
    AddObject('父',TObject(NewStr('昭和２８年６月１３日')));
    AddObject('母',TObject(NewStr('昭和３２年８月２２日')));
    AddObject('長女',TObject(NewStr('昭和５８年１０月１日')));
    AddObject('長男',TObject(NewStr('昭和６０年２月２５日')));
    AddObject('次女',TObject(NewStr('平成３年５月３１日')));
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i:integer;
begin
  for i := 0 to ListBox1.Items.Count-1 do
    Dispose(PString(ListBox1.Items.Objects[i]));
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  indx:integer;
  birthday:string;
begin
  indx := ListBox1.ItemIndex;
  birthday := PString(ListBox1.Items.Objects[indx])^;
  Label1.Caption  := Format('誕生日 : %s',[birthday]);
end;
n02304.gif

ここでは、string 型の変数で指定された文字列をメモリに記憶させて、その変数を指す PString 型のポインタを返すような関数 NewStr() を作った。非常に簡単な関数であるが、その意味をよく考えてみる価値はあるだろう。Objects[] には、PString を TObject にキャストして記憶させ、取り出すときは PString()^ のように、まず、PString() でキャストし、その逆参照 ＾ で string 型にしている。




[ レコード型を関連づける ]

任意の型のレコード型を Objects[] に関連づけるには、まず、そのレコード型とそれを指すポインタを宣言すると、上でやった String 型と PString の関係と同じようにして、New() と Dispose() を使うことができる。やってみよう。

まず、データをテキストファイルで用意しよう。ここでは、以下のようなコンマ区切りのテキストを用意した。

祖母,82,43,大正１０年３月３日
父,50,72,昭和２８年６月１３日
母,46,54,昭和３２年８月２２日
長女,20,48,昭和５８年１０月１日
長男,18,56,昭和６０年２月２５日
次女,12,42,平成３年５月３１日

これをレコード型にして、Objects[] に関連づける。以下にコードを示す。

List 8

type
PFamilyData = ^TFamilyData;
TFamilyData = record
  Name   :string;
  Age    :integer;
  Weight :integer;
  Birthday:string;
end;

function NewFamilyData(FD:TFamilyData):PFamilyData;
begin
  New(result);
  result^ := FD;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  SL1,SL2:TStringList;
  i:integer;
  FD:TFamilyData;
begin
  SL1 := TStringList.Create;
  SL2 := TStringList.Create;
  try
    SL1.LoadFromFile('c:\Family.txt');
    for i := 0 to SL1.Count-1 do begin
      SL2.CommaText := SL1[i];

      FD.Name := SL2[0];
      FD.Age  := StrToInt(SL2[1]);
      FD.Weight := StrToInt(SL2[2]);
      FD.Birthday := SL2[3];

      ListBox1.Items.AddObject(FD.Name,TObject(NewFamilyData(FD)));
    end;
  finally
    SL1.Free;
    SL2.Free;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i:integer;
begin
  for i := 0 to ListBox1.Items.Count-1 do
    Dispose(PFamilyData(ListBox1.Items.Objects[i]));
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  indx:integer;
  FD:TFamilyData;
begin
  indx := ListBox1.ItemIndex;
  FD := PFamilyData(ListBox1.Items.Objects[indx])^;
  Memo1.Clear;
  Memo1.Lines.Add('名  前：'+FD.Name);
  Memo1.Lines.Add('年  齢：'+IntToStr(FD.Age));
  Memo1.Lines.Add('体  重：'+IntToStr(FD.Weight));
  Memo1.Lines.Add('誕生日：'+FD.Birthday);
end;
n02305.gif

ここでは、データに対応するレコード型とそのポインタ型を定義し、FormCreate() で二つの TStringList を使って、コンマ区切りのテキストファイルからレコード型を組み立て、それをメモリに記憶させたときのポインタを Objects[] に設定している。ListBox1Click() では、PFamilyData()^ でレコード型を取得し、その内容を Memo1 に表示している。型が違うだけで、前回の String 型と PString のときと論理はまったく同じである。

 

[ 応用：文字列でソートする ]


Objects[] に関連づけられたオブジェクトが項目の文字列とともにソートされることを利用してみよう。

[ 質問 ]

MDI の子ウィンドウを使ってフォーム上に複数の画像を表示しています。その画像をカスケード表示するときにファイル名の昇順あるいは降順に表示させることはできますか？

[ 回答 ]

Cascade で整列される順序は、過去のフォーカスを得た順序（z-order）をさかのぼります。ですから、ファイル名を自前でソートして、フォーカスを与える順序を変えるといいです。画像のファイル名が子ウィンドウの　Caption に表示されていると仮定すると以下のようにします。

List 9

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    MakeChild: TMenuItem;
    Koujun: TMenuItem;
    Shoujun: TMenuItem;
    procedure MakeChildClick(Sender: TObject);
    procedure KoujunClick(Sender: TObject);
    procedure ShoujunClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    Count:integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Unit2;

procedure TForm1.MakeChildClick(Sender: TObject);
begin
  with TForm2.Create(Application) do
    Caption := Format('ChildForm %.3d',[Count]);
  Inc(Count);
end;

procedure TForm1.KoujunClick(Sender: TObject);
var
  SL:TStringList;
  i:integer;
begin
  SL := TStringList.Create;
  try
    for i := 0 to MDIChildCount-1 do
      SL.AddObject(MDIChildren[i].Caption,MDIChildren[i]);

    SL.Sort; // ソートはつねに昇順

    for i := 0 to MDIChildCount-1 do       //降順
      TForm(SL.Objects[i]).SetFocus;

    Cascade;
  finally
    SL.Free;
  end;
end;

procedure TForm1.ShoujunClick(Sender: TObject);
var
  SL:TStringList;
  i:integer;
begin
  SL := TStringList.Create;
  try
    for i := 0 to MDIChildCount-1 do
      SL.AddObject(MDIChildren[i].Caption,MDIChildren[i]);

    SL.Sort; // ソートはつねに昇順

    for i := MDIChildCount-1 downto 0 do //昇順
      TForm(SL.Objects[i]).SetFocus;

    Cascade;
  finally
    SL.Free;
  end;
end;

end.
n02306.gif

ここで、TForm2 は MDI の子フォームであり、あらかじめ自動生成の対象から外しておく。メニュー項目 MakeChild を何回かクリックして子フォームを複数つくる。適当に子フォームをクリックしたりサイズを変更したりしても、Koujun メニューを実行すると右図のようになる。



n02307.gif

また、Shoujun メニューをクリックすると右図のようになる。





以上、ここでは、Objects[] に代表されるオプションプロパティーの使い方を調べた。

redball.gif目次へ戻る