Namespace DelegateTest Class StringEx Inherits String Public Sub StringEx( str As String ) String( str ) End Sub End Class Delegate Sub Callback1() Delegate Function Callback2() As Long Delegate Sub Callback3( a As Long ) Delegate Sub Callback4( a As StringEx ) Delegate Function Callback7( str As String ) As String Delegate Sub CallbackTicket184( ByRef a As Long ) Class TestClass proc1Flag As Boolean proc2Flag As Boolean proc3Flag As Boolean proc4Flag As Boolean proc5Flag As Boolean proc6Flag As Boolean proc8Flag As Boolean proc9Flag As Boolean Static staticProc1Flag = False As Boolean Public x As DWord Sub TestClass() ClearFlags() x = 0 End Sub Sub ClearFlags() proc1Flag = False proc2Flag = False proc3Flag = False proc4Flag = False proc5Flag = False proc6Flag = False proc8Flag = True proc9Flag = False End Sub Function CheckFlags() As Boolean Return proc1Flag and proc2Flag and proc3Flag and proc4Flag and proc5Flag and proc6Flag and proc8Flag End Function Sub Proc1() proc1Flag = True End Sub Function Proc2() As Long proc2Flag = True End Function Sub Proc3or4( a As Long ) proc3Flag = (a=100) End Sub Sub Proc3or4( a As String ) proc4Flag = (a="Proc4 calling") End Sub Sub Proc5( a As String ) proc5Flag = (a="Proc4 calling") End Sub Sub Proc6( a As String ) proc6Flag = (a="Proc4 calling") End Sub Static Function Proc7( str As String ) As StringEx Return New StringEx( "Proc7 result[" + str + "]" ) End Function Sub Proc8( a As String ) proc8Flag = False End Sub Sub Proc9() proc9Flag = ( x = &H12345678 ) End Sub Sub Ticket177() Dim dg = New Callback1( AddressOf( This.Proc9 ) ) dg() End Sub Sub Ticket184( ByRef a As Long ) a = &H184 End Sub End Class Sub TestMain() Dim testObj As TestClass Dim dg1 = New Callback1( AddressOf(testObj.Proc1) ) Dim dg2 = New Callback2( AddressOf(testObj.Proc2) ) Dim dg3 = New Callback3( AddressOf(testObj.Proc3or4) ) Dim dg4 = New Callback4( AddressOf(testObj.Proc3or4) ) dg4 += AddressOf(testObj.Proc5) dg4 += AddressOf(testObj.Proc6) dg4 += AddressOf(testObj.Proc8) dg4 -= AddressOf(testObj.Proc8) dg1() dg2() dg3( 100 ) dg4( New StringEx( "Proc4 calling" ) ) ' 反変引数サポートのテスト testObj.x = &H12345678 testObj.Ticket177() UnitTest( "Delegate1", testObj.CheckFlags() ) Dim dg7 = New Callback7( AddressOf(TestClass.Proc7) ) ' 共変戻り値サポートのテスト UnitTest( "Delegate2", dg7( "test value" ) = "Proc7 result[test value]" ) Dim dg184 = New CallbackTicket184( AddressOf( testObj.Ticket184 ) ) Dim temp184 As Long dg184( temp184 ) UnitTest( "Delegate3", temp184 = &H184 ) End Sub End Namespace DelegateTest.TestMain()