Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2016年12月18日] [更新 2016年12月18日]　Delphi サンプルプログラム集
   
456_RTTI ( 実行時型情報 ) を使用したメソッドの実行
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro
456_RTTI_InvokeMethod.zip　3,566 KB]　2016年12月18日版 (EXE 同梱)






RTTI ( 実行時型情報 ) を使用したクラスやレコードのメソッドの実行


RTTI ユニットや TypInfo ユニットで実装されているクラスやメソッドを利用すると，実行時にクラスやレコード等の情報を取得したり，操作できます．
本ページは，主にクラスやレコードのメソッドを，RTTI (実行時型情報) から操作して実行するサシンプルです．Delphi 2010 で追加された RTTI の機能を使用していますが，RTTI の機能はその後も拡張されているようです．動作確認は Delphi XE5(UP2) Pro で行っています．





01_RTTI を使用して型情報を持つインスタンス名を列挙


RTTI は実行時の Delphi の型情報のことです．そこで，現在のアプリで使用可能な Delphi の型情報を持つインスタンスを列挙してみます．

本サンプルのフォームには，拙作の TplSetPrinter コンポーネントを配置しています．TplSetPrinter のインスタンスが実行時に自動生成されるので，関係するクラス名が列挙されます．
TplSetPrinter コンポーネントをフォームに配置しないで，uses に plSetPrinter を追加しただけではインスタンスは生成されません．したがって，列挙の対象にはなりません．



図1
設計時画面
  • 拙作の TplSetPrinter を配置
図2
実行結果
  • クラス名のリストということになる
  • TplSetPrinter 関係のクラス名が列挙されている

リスト1
型情報を持つインスタンス名を列挙する		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, plSetPrinter;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    plSetPrinter1: TplSetPrinter;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  IOUtils,
  RTTI,
  TypInfo,
  StrUtils;

{$R *.DFM}

//=============================================================================
//  型情報を持つインスタンス名を列挙
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LRttiContext : TRttiContext;
  LRttiTypes   : TArray<TRttiType>;
  LRttiType    : TRttiType;
  LText        : string;
  LCount       : Integer;
begin
  ListBox1.Items.Clear;
  ListBox1.Sorted := True;

  //型情報のリストを取得
  LRttiTypes := LRttiContext.GetTypes;

  ListBox1.Items.BeginUpdate;
  LCount := 0;
  for LRttiType in LRttiTypes do begin
    LText := LRttiType.Name;

    if CheckBox1.Checked then begin
      //プリフィックスがTのインスタンス名だけをリスト
      if LeftStr(LText, 1) = 'T' then begin
        Inc(LCount);
        ListBox1.Items.Add(LText);
      end;
    end else begin
      //全てのインスタンス名をリスト
      Inc(LCount);
      ListBox1.Items.Add(LText);
    end;
  end;

  Label1.Caption := IntToStr(LCount);
  ListBox1.Items.EndUpdate;
end;

end.



02_RTTI を使用してクラスやレコードのメソッドを実行


クラスやレコードのメソッドを RTTI の機能を使用して実行するサシンプルです．
TRttiType.AsInstance でインスタンスを取得して実行しますが，レコードのクラス型のメソッドの場合は，Rtti.Invoke で実行しています．

クラスまたはレコードの型情報は，型のデータのポインタから TRttiContext.GetType 関数で取得できます．型のデータのポインタは，型の識別子から TypeInfo 関数で取得できます．例えば，TButton という型データのポインタは TypeInfo(TButton) で取得できます．



[備考]
レコードやクラスの型名は TRttiType.Name で取得できます．
引数の ApTypeInfo からは GetTypeName(ApTypeInfo) で取得できます．


図3
引数がないクラスの関数の実行例
図4
引数があるクラスの関数の実行例
図5
引数がないレコードの関数の実行例
図6
引数があるレコードの関数の実行例

リスト2
RTTI を使用してクラスとレコードのメソッドを実行
テスト用のクラスとレコードのコードは別ユニットにある		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.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);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Unit2,
  IOUtils,
  RTTI,
  TypInfo;

{$R *.DFM}

//-----------------------------------------------------------------------------
//  レコードとクラスのメソッドを実行する関数
//
//  ApTypeInfo  : TypeInfoで取得した値
//  AMethodName : 実行するメソッド名の文字列
//  AArgs       : メソッドの引数のリスト
//-----------------------------------------------------------------------------
function InvokeRecordClassMethod(const ApTypeInfo: PTypeInfo;
  const AMethodName: string; const AArgs: TArray<TValue>): TValue;
var
  LRttiContext : TRttiContext;
  LRttiType    : TRttiType;
  LRttiMethod  : TRttiMethod;
  LInstance    : TRttiInstanceType;
begin
  //引数の型情報を取得
  LRttiType := LRttiContext.GetType(ApTypeInfo);

  if Assigned(LRttiType) then begin
    //メソッド名からメソッドの情報を取得
    LRttiMethod := LRttiType.GetMethod(AMethodName);

    //実行
    if LRttiMethod <> nil then begin
      //レコードのメソッドの場合
      if LRttiType.TypeKind = tkRecord then begin
        if LRttiMethod.IsStatic then begin
          //レコードのクラス型メソッドの場合
          Result := Rtti.Invoke(LRttiMethod.CodeAddress,
                                AArgs,
                                LRttiMethod.CallingConvention,
                                LRttiMethod.ReturnType.Handle,
                                LRttiMethod.IsStatic);
        end else begin
          //引数のApTypeInfoの値はLRttiType.Handleと同じ
          Result := LRttiMethod.Invoke(TValue.From<Pointer>(ApTypeInfo), AArgs);
        end;
      end else
      //クラスのメソッドの場合
      if LRttiType.TypeKind = tkClass then begin
        LInstance := LRttiType.AsInstance;
        Result :=  LRttiMethod.Invoke(LInstance, AArgs);
      end;
    end;
  end;
end;

//=============================================================================
//  クラスのメソッドの実行例
//  引数なしの関数の場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LpTypeInfo : PTypeInfo;
  LArgs    　 : TArray<TValue>;
  LTValue   　: TValue;
begin
  LpTypeInfo := TypeInfo(TMyClass);

  //nilにしなくても動作する
  LArgs   := nil;
  LTValue := InvokeRecordClassMethod(LpTypeInfo, 'GetValue', LArgs);
  MessageBox(Handle, PChar(IntToStr(LTValue.AsInteger)), '結果', MB_ICONINFORMATION);
end;

//=============================================================================
//  クラスのメソッドの実行例
//  引数がある関数の場合
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LpTypeInfo : PTypeInfo;
  LArgs    　 : TArray<TValue>;
  LInteger  　: Integer;
begin
  LpTypeInfo := TypeInfo(TMyClass);

  //テストする関数の引数は2つで，共にInteger型
  SetLength(LArgs, 2);
  LArgs[0] := TValue.From<Integer>(1000);
  LArgs[1] := TValue.From<Integer>(2000);

  LInteger := InvokeRecordClassMethod(LpTypeInfo, 'AddInteger', LArgs).AsInteger;
  MessageBox(Handle, PChar(IntToStr(LInteger)), '結果', MB_ICONINFORMATION);
end;

//=============================================================================
//  レコードのメソッドの実行例
//  引数なしの関数の場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  LpTypeInfo : PTypeInfo;
  LArgs      : TArray<TValue>;
  LTValue    : TValue;
begin
  LpTypeInfo := TypeInfo(TMyRecord);

  //nilにしなくても動作する
  LArgs   := nil;
  LTValue := InvokeRecordClassMethod(LpTypeInfo, 'GetValue', LArgs);
  MessageBox(Handle, PChar(LTValue.AsString), '結果', MB_ICONINFORMATION);
end;

//=============================================================================
//  レコードのメソッドの実行例
//  引数がある関数の場合
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  LpTypeInfo : PTypeInfo;
  LArgs      : TArray<TValue>;
  LInteger   : Integer;
begin
  LpTypeInfo := TypeInfo(TMyRecord);

  //テストする関数の引数は2つで，共にInteger型
  SetLength(LArgs, 2);
  LArgs[0] := TValue.From<Integer>(100);
  LArgs[1] := TValue.From<Integer>(200);

  LInteger := InvokeRecordClassMethod(LpTypeInfo, 'AddInteger', LArgs).AsInteger;
  MessageBox(Handle, PChar(IntToStr(LInteger)), '結果', MB_ICONINFORMATION);
end;

end.


リスト3
テストに使用したクラスとレコードを定義したユニットのコード		 
unit Unit2;

interface

uses
  Windows, Messages;

type
  TMyRecord = record
  public
    function GetValue: string;
    class function AddInteger(ValueA, ValueB : Integer): Integer; static;
  end;

  TMyClass = class
  public
    // 引数のないクラスメソッド
    class function GetValue: Integer; static;
    // 引数のあるクラスメソッド
    class function AddInteger(ValueA, ValueB : Integer): Integer; static;
  end;

implementation

{ TMyRecord }

//=============================================================================
//  TMyRecordの実装部のコード
//=============================================================================
function TMyRecord.GetValue: string;
begin
  Result := '日本 東京都';
end;

class function TMyRecord.AddInteger(ValueA, ValueB: Integer): Integer;
begin
  Result := ValueA + ValueB;
end;

{ TMyClass }

//=============================================================================
//  TMyClassの実装部のコード
//=============================================================================
class function TMyClass.GetValue: Integer;
begin
  Result := 5200;
end;

class function TMyClass.AddInteger(ValueA, ValueB: Integer): Integer;
begin
  Result := ValueA + ValueB;
end;

end.



03_クラスやレコードの型を文字列で指定する場合


TRttiContext.FindType メソッドを使用すると，文字列でクラス名やレコード名を指定できます．ただし，クラス名やレコード名にはユニットスコープ名が必要です．
また，情報を取得するクラスは，そのインスタンスが生成されていなければ取得できません．レコードの場合は，そのレコードを実際に使用するコードがないと，コンパイルの時に最適化によって意味のないコードは削除されてしまいます．

下のコードでは，ダミーのコードを実行することで情報を取得可能にしています．



図7
TPath.GetSharedMoviesPath の実行結果

リスト4
クラスやレコードの型を文字列で指定する例		 
//-----------------------------------------------------------------------------
//  レコードとクラスのメソッドを実行する関数
//
//  ATypeName   : ユニットスコープ付きの型の名前
//  AMethodName : 実行するメソッド名の文字列
//  AArgs       : メソッドの引数のリスト
//-----------------------------------------------------------------------------
function InvokeRecordClassMethod(const ATypeName: string;
  const AMethodName: string; const AArgs: TArray<TValue>): TValue;
var
  LRttiContext : TRttiContext;
  LRttiType    : TRttiType;
  LpTypeInfo   : PTypeInfo;
  LRttiMethod  : TRttiMethod;
  LInstance    : TRttiInstanceType;
begin
  //引数の型情報を取得
  LRttiType := LRttiContext.FindType(ATypeName);

  if Assigned(LRttiType) then begin
    LpTypeInfo := LRttiType.Handle;
    //メソッド名からメソッドの情報を取得
    LRttiMethod := LRttiType.GetMethod(AMethodName);

    //実行
    if LRttiMethod <> nil then begin
      //レコードのメソッドの場合
      if LRttiType.TypeKind = tkRecord then begin
        if LRttiMethod.IsStatic then begin
          //レコードのクラス型メソッドの場合
          Result := Rtti.Invoke(LRttiMethod.CodeAddress,
                                AArgs,
                                LRttiMethod.CallingConvention,
                                LRttiMethod.ReturnType.Handle,
                                LRttiMethod.IsStatic);
        end else begin
          Result := LRttiMethod.Invoke(TValue.From<Pointer>(LpTypeInfo), AArgs);
        end;
      end else
      //クラスのメソッドの場合
      if LRttiType.TypeKind = tkClass then begin
        LInstance := LRttiType.AsInstance;
        Result :=  LRttiMethod.Invoke(LInstance, AArgs);
      end;
    end;
  end;
end;

//=============================================================================
//  クラスのメソッドの実行例
//  引数なしの関数の場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LpTypeInfo  : PTypeInfo;
  LTypeName   : string;
  LMethodName : string;
  LArgs    　 : TArray<TValue>;
  LTValue   　: TValue;
begin
  //ダミーのコード
  //型を使用するコードがないと型の情報は取得できない
  LpTypeInfo := TypeInfo(TMyClass);

  LTypeName   := 'Unit2.TMyClass';
  LMethodName := 'GetValue';

  //nilにしなくても動作する
  LArgs   := nil;
  LTValue := InvokeRecordClassMethod(LTypeName, LMethodName, LArgs);
  MessageBox(Handle, PChar(IntToStr(LTValue.AsInteger)), '結果', MB_ICONINFORMATION);
end;

//=============================================================================
//  レコードのメソッドの実行例
//  引数なしの関数の場合
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LpTypeInfo  : PTypeInfo;
  LTypeName   : string;
  LMethodName : string;
  LArgs       : TArray<TValue>;
  LTValue     : TValue;
begin
  //ダミーのコード
  //型を使用するコードがないと型の情報は取得できない
  LpTypeInfo := TypeInfo(TPath);

  LTypeName   := 'System.IOUtils.TPath';
  LMethodName := 'GetSharedMoviesPath';

  //nilにしなくても動作する
  LArgs   := nil;
  LTValue := InvokeRecordClassMethod(LTypeName, LMethodName, LArgs);
  MessageBox(Handle, PChar(LTValue.AsString), '結果', MB_ICONINFORMATION);
end;



04_RTTI を使用して指定レコードのメソッド名を列挙して実行


TPath のメソッド名の一覧を取得して，選択したメソッド名のメソッドを実行する例です．
Delphi XE5 では，TPath に特殊フォルダのフルパスを取得する関数類が追加されました．それらの関数のテストです．


図8
TPath のメソッド名の一覧
  • GetFullPath は，指定されたパスの絶対パスを返す関数
  • その他は特殊フォルダを取得するメソッド名
  • 上部の TEdit の値は，選択した項目のメソッドを実行した結果

リスト5
RTTI を使用して TPath のメソッド名の一覧を取得して実行
特殊フォルダを取得するメソッド名と思われるメソッド名だけを列挙		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  RTTI,
  TypInfo,
  StrUtils,
  IOUtils;

{$R *.DFM}

//=============================================================================
//  RTTIを使用してTPathのメソッド名を列挙
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LRttiContext : TRttiContext;
  LRttiType    : TRttiType;
  LRttiMethods : TArray<TRttiMethod>;
  LRttiMethod  : TRttiMethod;
begin
  ListBox1.Items.Clear;

  //型の情報取得
  LRttiType := LRttiContext.GetType(TypeInfo(TPath));

  //レコード型であればメソッドのリストを取得
  if (LRttiType <> nil) and (LRttiType.TypeKind = tkRecord) then begin
    LRttiMethods := LRttiType.GetMethods;

    //メソッド名の先頭がGetで，末尾がPathのメソッドを抽出して表示
    ListBox1.Items.BeginUpdate;
    for LRttiMethod in LRttiMethods do begin
      if UpperCase(LeftStr(LRttiMethod.Name, 3)) = 'GET' then begin
        if UpperCase(RightStr(LRttiMethod.Name, 4)) = 'PATH' then begin
          ListBox1.Items.Add(LRttiMethod.Name);
        end;
      end;
    end;
    ListBox1.Items.EndUpdate;
  end;
end;

//=============================================================================
//  ListBox1のOnClickイベント処理
//  RTTIを使用してTPathのメソッドを実行
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  LIndex       : Integer;
  LpTypeInfo   : PTypeInfo;
  LRttiContext : TRttiContext;
  LRttiType    : TRttiType;
  LRttiMethod  : TRttiMethod;
  LArgs        : TArray<TValue>;
  LTValue      : TValue;
begin
  Edit1.Text := '';
  LIndex     := ListBox1.ItemIndex;
  if LIndex < 0 then exit;

  //型情報を取得
  LRttiType := LRttiContext.GetType(TypeInfo(TPath));

  if Assigned(LRttiType) then begin
    //メソッド名からメソッドの情報を取得
    LRttiMethod := LRttiType.GetMethod(Trim(ListBox1.Items[LIndex]));

    //実行
    if LRttiMethod <> nil then begin
      LTValue := Rtti.Invoke(LRttiMethod.CodeAddress,
                             LArgs,
                             LRttiMethod.CallingConvention,
                             LRttiMethod.ReturnType.Handle,
                             LRttiMethod.IsStatic);
      Edit1.Text := LTValue.AsString;
    end;
  end;
end;

end.


上のコードではレコード型の情報だけを使用しています．レコードの情報だけを取得するのであれば，次のように，最初から TRttiRecordType の情報として取得することもできます． 



//=============================================================================
//  RTTIを使用してTPathのメソッド名を列挙
//  TPathはレコードなので，最初からTRttiRecordTypeにキャストする場合
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  LRttiContext : TRttiContext;
  LRttiRecType : TRttiRecordType;
  LRttiMethods : TArray<TRttiMethod>;
  LRttiMethod  : TRttiMethod;
begin
  ListBox1.Items.Clear;

  //レコード型としてTPathの情報を取得
  LRttiRecType := LRttiContext.GetType(TypeInfo(TPath)).AsRecord;
  //メソッドのリストを取得
  LRttiMethods := LRttiRecType.GetMethods;

  //メソッド名の先頭がGetで，末尾がPathのメソッドを抽出して表示
  ListBox1.Items.BeginUpdate;
  for LRttiMethod in LRttiMethods do begin
    if UpperCase(LeftStr(LRttiMethod.Name, 3)) = 'GET' then begin
      if UpperCase(RightStr(LRttiMethod.Name, 4)) = 'PATH' then begin
        ListBox1.Items.Add(LRttiMethod.Name);
      end;
    end;
  end;
  ListBox1.Items.EndUpdate;
end;