クラスの入門例について(7):フォームのすべての親を巡回する

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls;



type

  TForm1 = class(TForm)

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

  end;



var

  Form1: TForm1;



implementation



{$R *.dfm}



//

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(Self.ClassName);                         {TForm1      - Form1  }

  ShowMessage(Self.ClassParent.ClassName);             {TForm       - Form1  }

  ShowMessage(Self.ClassParent.ClassParent.ClassName); {TCustomForm - Form1  }

end;



//

procedure TForm1.Button2Click(Sender: TObject);

var

  MyClass: TClass;

  {TClass   TObject  ;   TObject  ,  }

begin

  {  ClassType   TClass}

  ShowMessage(Self.ClassType.ClassName); {TForm1 - Form1  }



  MyClass := Self.ClassType;

  ShowMessage(MyClass.ClassName);        {TForm1 - Form1  }

end;



//

procedure TForm1.Button3Click(Sender: TObject);

var

  MyClass: TClass;

begin

  {  ClassParent   TClass,   ClassParent   TClass  }



  MyClass := Self.ClassType;

  ShowMessage(MyClass.ClassName); {TForm1      - Form1  }



  MyClass := MyClass.ClassParent;

  ShowMessage(MyClass.ClassName); {TForm       - Form1  }



  MyClass := MyClass.ClassParent;

  ShowMessage(MyClass.ClassName); {TCustomForm - Form1  }

end;



// 

procedure TForm1.Button4Click(Sender: TObject);

var

  MyClass: TClass;

begin

  MyClass := Self.ClassType;



  while MyClass <> nil do

  begin

    ShowMessage(MyClass.ClassName);

    MyClass := MyClass.ClassParent;

  end;



{ :

  TForm1

  TForm

  TCustomForm

  TScrollingWinControl

  TWinControl

  TControl

  TComponent

  TPersistent

  TObject

}

end;



end.