[340] | 1 | Namespace DelegateTest
|
---|
| 2 |
|
---|
[491] | 3 | Class StringEx
|
---|
| 4 | Inherits String
|
---|
| 5 | Public
|
---|
| 6 | Sub StringEx( str As String )
|
---|
| 7 | String( str )
|
---|
| 8 | End Sub
|
---|
| 9 | End Class
|
---|
| 10 |
|
---|
[340] | 11 | Delegate Sub Callback1()
|
---|
| 12 | Delegate Function Callback2() As Long
|
---|
| 13 | Delegate Sub Callback3( a As Long )
|
---|
[491] | 14 | Delegate Sub Callback4( a As StringEx )
|
---|
[342] | 15 | Delegate Function Callback7( str As String ) As String
|
---|
[569] | 16 | Delegate Sub CallbackTicket184( ByRef a As Long )
|
---|
[340] | 17 |
|
---|
| 18 | Class TestClass
|
---|
| 19 | proc1Flag As Boolean
|
---|
| 20 | proc2Flag As Boolean
|
---|
| 21 | proc3Flag As Boolean
|
---|
| 22 | proc4Flag As Boolean
|
---|
| 23 | proc5Flag As Boolean
|
---|
| 24 | proc6Flag As Boolean
|
---|
[352] | 25 | proc8Flag As Boolean
|
---|
[549] | 26 | proc9Flag As Boolean
|
---|
[340] | 27 |
|
---|
| 28 | Static staticProc1Flag = False As Boolean
|
---|
| 29 |
|
---|
| 30 | Public
|
---|
[549] | 31 |
|
---|
| 32 | x As DWord
|
---|
| 33 |
|
---|
[340] | 34 | Sub TestClass()
|
---|
| 35 | ClearFlags()
|
---|
[549] | 36 | x = 0
|
---|
[340] | 37 | End Sub
|
---|
| 38 |
|
---|
| 39 | Sub ClearFlags()
|
---|
| 40 | proc1Flag = False
|
---|
| 41 | proc2Flag = False
|
---|
| 42 | proc3Flag = False
|
---|
| 43 | proc4Flag = False
|
---|
| 44 | proc5Flag = False
|
---|
| 45 | proc6Flag = False
|
---|
[352] | 46 | proc8Flag = True
|
---|
[549] | 47 | proc9Flag = False
|
---|
[340] | 48 | End Sub
|
---|
| 49 | Function CheckFlags() As Boolean
|
---|
[352] | 50 | Return proc1Flag and proc2Flag and proc3Flag and proc4Flag and proc5Flag and proc6Flag and proc8Flag
|
---|
[340] | 51 | End Function
|
---|
| 52 |
|
---|
| 53 | Sub Proc1()
|
---|
| 54 | proc1Flag = True
|
---|
| 55 | End Sub
|
---|
| 56 |
|
---|
[343] | 57 | Function Proc2() As Long
|
---|
[340] | 58 | proc2Flag = True
|
---|
[343] | 59 | End Function
|
---|
[340] | 60 |
|
---|
| 61 | Sub Proc3or4( a As Long )
|
---|
| 62 | proc3Flag = (a=100)
|
---|
| 63 | End Sub
|
---|
| 64 |
|
---|
| 65 | Sub Proc3or4( a As String )
|
---|
| 66 | proc4Flag = (a="Proc4 calling")
|
---|
| 67 | End Sub
|
---|
| 68 |
|
---|
| 69 | Sub Proc5( a As String )
|
---|
| 70 | proc5Flag = (a="Proc4 calling")
|
---|
| 71 | End Sub
|
---|
| 72 |
|
---|
| 73 | Sub Proc6( a As String )
|
---|
| 74 | proc6Flag = (a="Proc4 calling")
|
---|
| 75 | End Sub
|
---|
| 76 |
|
---|
[491] | 77 | Static Function Proc7( str As String ) As StringEx
|
---|
| 78 | Return New StringEx( "Proc7 result[" + str + "]" )
|
---|
[340] | 79 | End Function
|
---|
[352] | 80 |
|
---|
| 81 | Sub Proc8( a As String )
|
---|
| 82 | proc8Flag = False
|
---|
| 83 | End Sub
|
---|
[549] | 84 |
|
---|
| 85 | Sub Proc9()
|
---|
| 86 | proc9Flag = ( x = &H12345678 )
|
---|
| 87 | End Sub
|
---|
| 88 |
|
---|
| 89 | Sub Ticket177()
|
---|
| 90 | Dim dg = New Callback1( AddressOf( This.Proc9 ) )
|
---|
| 91 | dg()
|
---|
| 92 | End Sub
|
---|
[569] | 93 |
|
---|
| 94 | Sub Ticket184( ByRef a As Long )
|
---|
| 95 | a = &H184
|
---|
| 96 | End Sub
|
---|
[340] | 97 | End Class
|
---|
| 98 |
|
---|
| 99 | Sub TestMain()
|
---|
| 100 | Dim testObj As TestClass
|
---|
| 101 | Dim dg1 = New Callback1( AddressOf(testObj.Proc1) )
|
---|
| 102 | Dim dg2 = New Callback2( AddressOf(testObj.Proc2) )
|
---|
| 103 | Dim dg3 = New Callback3( AddressOf(testObj.Proc3or4) )
|
---|
| 104 | Dim dg4 = New Callback4( AddressOf(testObj.Proc3or4) )
|
---|
| 105 | dg4 += AddressOf(testObj.Proc5)
|
---|
| 106 | dg4 += AddressOf(testObj.Proc6)
|
---|
[352] | 107 | dg4 += AddressOf(testObj.Proc8)
|
---|
| 108 | dg4 -= AddressOf(testObj.Proc8)
|
---|
[340] | 109 |
|
---|
| 110 | dg1()
|
---|
| 111 | dg2()
|
---|
| 112 | dg3( 100 )
|
---|
[491] | 113 | dg4( New StringEx( "Proc4 calling" ) ) ' 反変引数サポートのテスト
|
---|
[340] | 114 |
|
---|
[549] | 115 | testObj.x = &H12345678
|
---|
| 116 | testObj.Ticket177()
|
---|
| 117 |
|
---|
[340] | 118 | UnitTest( "Delegate1", testObj.CheckFlags() )
|
---|
[342] | 119 |
|
---|
[491] | 120 | Dim dg7 = New Callback7( AddressOf(TestClass.Proc7) ) ' 共変戻り値サポートのテスト
|
---|
[342] | 121 | UnitTest( "Delegate2", dg7( "test value" ) = "Proc7 result[test value]" )
|
---|
| 122 |
|
---|
[569] | 123 | Dim dg184 = New CallbackTicket184( AddressOf( testObj.Ticket184 ) )
|
---|
| 124 | Dim temp184 As Long
|
---|
| 125 | dg184( temp184 )
|
---|
| 126 | UnitTest( "Delegate3", temp184 = &H184 )
|
---|
| 127 |
|
---|
[340] | 128 | End Sub
|
---|
| 129 |
|
---|
| 130 | End Namespace
|
---|
| 131 |
|
---|
| 132 | DelegateTest.TestMain()
|
---|