日曜日は、山本さんに会う機会があったのですが、どうやらインタフェースへの対応は思っていたより面倒なようです。もう少し考えて見ます。
今度は、クラス用と別にインタフェース用のvtblを用意するという方法を試してみました。
これを基のコードとします。@367のBasicCompiler32.exeでコンパイルできます。
Interface A
Sub ProcA1()
Sub ProcA2(n As Long)
End Interface
Interface B
Function ProcB1() As Long
End Interface
Class C
Implements A, B
Public
Sub ProcA1() : Print "ProcA1" : End Sub
Sub ProcA2(n As Long) : Print "ProcA2", n : End Sub
Function ProcB1() As Long : Print "ProcB1" : Return 201 : End Function
End Class
'----ユーザ部分
Dim c = New C
Dim a = c As A
a.ProcA1()
a.ProcA2(777)
Dim b = c As B
Print b.ProcB1()こういうふうにコンパイルされたら、うまくいくはずです（これも@367のBasicCompiler32.exeでコンパイルできます）。
Type InterfaceBase '現InterfaceStructure相当
vtbl As *VoidPtr
thisObj As Object
End Type
'クラスはImplementsを除いて扱う
Class C
' Implements A, B
Public
'現状の仕様上、インタフェースの実装に使われるメソッドは
'全てVirtualにすべきであったはず。
Virtual Sub ProcA1() : Print "ProcA1" : End Sub
Virtual Sub ProcA2(n As Long) : Print "ProcA2", n : End Sub
Virtual Function ProcB1() As Long : Print "ProcB1" : Return 201 : End Function
End Class
'----インタフェースAを宣言したため生成されるコード
Type Interface_A_VTable
ProcA1 As *Sub(pthis As *Interface_A)
ProcA2 As *Sub(pthis As *Interface_A, n As Long)
End Type
Type Interface_A 'Interface Aの実態
vtbl As *Interface_A_VTable
thisObj As Object
End Type
'----インタフェースBを宣言したために生成されるコード
Type Interface_B_VTable
ProcB1 As *Function(pthis As *Interface_B) As Long
End Type
Type Interface_B 'Interface Bの実態
vtbl As *Interface_B_VTable
thisObj As Object
End Type
'----Cがインタフェースを実装したために生成されるコード
/*
インタフェースの実装に用いられるメソッドそれぞれについて、
インタフェースメソッド経由用のラッパを作る。
*/
Sub C_InterfaceMethod_ProcA1(p As *InterfaceBase)
Dim rthis = p->thisObj As C
rthis.ProcA1()
End Sub
Sub C_InterfaceMethod_ProcA2(p As *InterfaceBase, n As Long)
Dim rthis = p->thisObj As C
rthis.ProcA2(n)
End Sub
Function C_InterfaceMethod_ProcB1(p As *InterfaceBase) As Long
Dim rthis = p->thisObj As C
Return rthis.ProcB1()
End Function
'----CがAを実装したため生成されるコード
Dim C_A_vtbl As Interface_A_VTable
C_A_vtbl.ProcA1 = AddressOf(C_InterfaceMethod_ProcA1)
C_A_vtbl.ProcA2 = AddressOf(C_InterfaceMethod_ProcA2)
Function CastC2A(c As Object) As *Interface_A
CastC2A = GC_malloc(SizeOf (Interface_A))
With CastC2A[0]
.vtbl = VarPtr(C_A_vtbl)
.thisObj = c As Object
End With
End Function
'----CがBを実装したため生成されるコード
Dim C_B_vtbl As Interface_B_VTable
C_B_vtbl.ProcB1 = AddressOf(C_InterfaceMethod_ProcB1)
Function CastC2B(c As Object) As *Interface_B
CastC2B = GC_malloc(SizeOf (Interface_B))
With CastC2B[0]
.vtbl = VarPtr(C_B_vtbl)
.thisObj = c As Object
End With
End Function
'----ユーザ部分
Dim c = New C
'Dim a = c As A
Dim a = CastC2A(c)
'a.ProcA1()
Dim pa1 = a->vtbl->ProcA1
pa1(a)
'a.ProcA2(777)
Dim pa2 = a->vtbl->ProcA2
pa2(a, 777)
'Dim b = c As B
Dim b = CastC2B(c)
'Print b.ProcB1()
Dim pb1 = b->vtbl->ProcB1
Dim ret = pb1(b)
Print ret
Sleep(-1)インタフェース型へのキャストは、新たにインタフェースオブジェクトの作成となります（上ではCastC2A, CastC2Bという関数になっています）。そして、Interface_AやInterface_Bがインタフェースオブジェクトの実態であり実体となります。これらは、みなInterfaceBase型としても扱えます。そのメンバvtblが指すのはCOMインタフェース仕様のvtblです。もちろんクラス単位で共有されます。もう1つのメンバ、thisObjは基のクラスオブジェクトを指します。
上のコードになかった逆のインタフェースオブジェクトからクラス型へのキャストは、インタフェースからthisObjを取り出して、そこからキャストすることになります。Objectクラスのメソッドの使用、特に型情報取得も同様にします。
関数呼出はCOMのインタフェースメソッドと同じで、特記すべきことはありません。
これでうまくいくのでしょうか？というわけでOLEドラッグアンドドロップをこれで移植してみました: DragDrop5。（元からそうですが）IDataObject回りが手付かずなので、ドロップされた中身は見れませんが、問題なく動きます。
なお、この場合ではクラス型がインタフェースを実装していることがコンパイル時に分かる場合にしか、インタフェース型へキャストできません。そこらへんの話は次回です。
| スポンサード リンク |