VB/VBA のイベントの仕様

つぎの2つの大きな問題がある。

• イベントハンドラーを共有できない。インスタンスが100個あったら、イベントハンドラーの Sub も100個書いておかないといけない。配列などにも対応できない。おおもとはイベントハンドラーをインスタンスに割り当てるのではなく変数に割り当てるという発想から来ている。( id:unibon:20070828:p6 )
• イベントハンドラーが継承(Implements)に対応していない。( id:unibon:20070829:p4 )

これらを解決するためにラッパークラスを作った。

EventCollector.cls:

Option Explicit

Public Event PopCmd(ByVal Task As ITask, ByVal Cmd As ICmd)

Private Eventers As Collection ' Eventer

Private Sub Class_Initialize()
    Set Eventers = New Collection
End Sub

Public Sub DoPopEvent(ByVal Task As ITask, ByVal Cmd As ICmd)
    RaiseEvent PopCmd(Task, Cmd)
End Sub

Public Sub AddTask(ByVal Task As ITask)
    Dim ev As Eventer
    Set ev = New Eventer
    
    ' 逆方向の関連付けを設定する。循環参照が残らないように注意しよう。
    Call ev.SetEventCollector(Me)
    
    Call ev.SetTask(Task)
    
    Call Eventers.Add(ev)
End Sub

Public Sub RemoveTask(ByVal Task As ITask)
    Dim found As Boolean
    found = False
    Dim i As Long
    ' Collection を Remove するので降順で処理する。(Remove は1回だけなので必須ではない。)
    For i = Eventers.Count - 1 To 0 Step -1
        Dim ev As Eventer
        Set ev = Eventers.Item(i + 1)
        If ev.GetTask() Is Task Then
            If found Then
                ' 重複していた。
                Call Err.Raise(50000)
            End If
            found = True
                
            ' 循環参照が残らないようにする。
            Call ev.SetEventCollector(Nothing)
            
            Call Eventers.Remove(i + 1)
        End If
    Next
    If Not found Then
        ' 引数で指定されたタスクが見つからなかった。
        Call Err.Raise(50000)
    End If
End Sub

Eventer.cls:

Option Explicit

Private WithEvents vst As SimpleTask

Private Ec As EventCollector

' タスクがコマンドを発生させたイベントを受けるイベントハンドラー。
Private Sub vst_GenCmd(ByVal GeneratedCmd As ICmd)
    Call Ec.DoPopEvent(vst, GeneratedCmd)
End Sub

Public Sub SetEventCollector(ByVal ArgEc As EventCollector)
    Set Ec = ArgEc
End Sub

Public Sub SetTask(ByVal ArgTask As ITask)
    Select Case TypeName(ArgTask)
    Case "SimpleTask"
        Set vst = ArgTask
    Case Else
        Call Err.Raise(50000)
    End Select
End Sub

Public Function GetTask() As ITask
    Set GetTask = vst
End Function

...SetTask メソッドの中では、ITask クラスのサブクラスの種類を Select Case で分類しないといけない。これは汚いが VB/VBA の仕様の制限上、どうしようもない。