REALbasicでクラス名（String）からそのクラスのインスタンスを作る方法

REALbasicでは通常、インスタンスの作成には「New クラス名」という記述方法をする以外の方法はありません。

  Dim D as Dictuinary = New Dictionary

この時の「Dictionary」はあくまでコンパイル時に解釈されるので、実行時に変更する事はできないのだけど・・・

これがもし、

  Dim D as Dictuinary = Create("Dictionary")

みたいにできたら楽しいと思うの。

で、やってみた。

説明ややこしいのでソース全部のせます。

ポイントは、Introspectionを使ってClassInfo.Lookupメソッド（リファレンス未記載）を呼んで、文字列から該当クラスのTypeInfoを取得するところ。

未記載のクラス・メソッドを利用しているので一切公式の保証はありませんが、一応2008r5と2010r5で動作するらしいことを確認しました。
（本当に大丈夫なのかはわかりません。。）

function NewObject(ClassName as String,Params() as Variant) as Object

  '// Create a new instanse by ClassName string
  '// 2011 yuki@nekobooks.com
  '//
  '// ex: Dim o as Object = NewObject("Dictionary")
  
  
  'search 'Lookup' method
  If mLookup = Nil Then 'mLookup is Modul's property to chche ,and is null at first.
    'get an object of ClassInfo 
    'this ClassInfo object is used for calling 'Lookup' method
    Dim T as Introspection.TypeInfo = Introspection.GetType(Introspection.GetType(app)) 
    Dim Ms() as Introspection.MethodInfo = T.GetMethods
    
    'search 'Lookup' method 
    For each M as Introspection.MethodInfo In Ms
      Dim Ps() as Introspection.ParameterInfo = M.GetParameters()
      If M.Name = "Lookup" and UBound(Ps) = 0 Then
        If Ps(0).ParameterType.FullName = "String" Then
          mLookup = M 'cache Lookup method
          Exit
        End If
      End If
    Next
  End If
  
  If mLookup = Nil Then
    Return Nil 'fail to find Lookup method
  End If
  
  'Lookup target ClassInfo
  Dim LookupParam(0) as Variant
  LookupParam(0) = ClassName
  Dim TargetClassInfo as Introspection.TypeInfo = Introspection.TypeInfo(mLookup.Invoke(Nil,LookupParam))
  If TargetClassInfo = Nil Then
    Return Nil 'Class NOT Found
  End If
  
  'get constructors
  Dim CnstrI() as Introspection.ConstructorInfo = TargetClassInfo.GetConstructors()
  
  'Try each constructor
  Dim V as Variant
  For each C as Introspection.ConstructorInfo in CnstrI
    Try
      V = C.Invoke(Params) 'raise an exception if param count or type is missmatched. then try next
      Exit
    Catch TEx as TypeMismatchException
    End Try
  Next
  
  Return V.ObjectValue

End Function

面白いけど、どう使おう。。