Custom EventをCallbackに変える
クラスモジュールを用いて作ったオブジェクトには、イベントを持たせることができる。
今回は、このCustom Eventと同様のことを、別のやり方でやってみる。
Custom Eventの場合は、Event、RaiseEvent、WithEventsという三つのキーワードを用いましたが、今度はインターフェース用のクラスモジュールとImplementsキーワードを用います。
『VBA Developer's Handbook Second Edition』で紹介されていたテクニックです。いつもありがとうございます。
目次
こんなことができます
たとえば、
Private Sub testDekosuke01()
Dim ds As Dekosuke
Set ds = New Dekosuke
Set ds.Callback = New ImmWndCallback
Call ds.Say("ち~んw")
ds.Name = "諸葛亮"
Call ds.Say("他にすることはないのですか?")
End Sub
こんなコードを実行するだけで、

こんな動作をさせる裏で、イミディエイトに

こんな風に出力させることができる。
上掲コード中、DekosukeクラスのインスタンスdsがSayメソッドを実行したときに、あたかもイベントが発生したかのように、イミディエイトに文字列が出力されたのである。
もちろん、Custom Eventを使わずに、である。
前述のように、代わりにIDekosukeCallbackというインターフェース用クラスモジュールと、Implementsキーワード、そして、イベントを受け取ってイミディエイトに出力するためのImmWndCallbackクラスモジュールを使う。
準備
Dekosukeクラスを作る
まずは、Dekosukeクラスを作る。
なるべく単純にするために、インスタンス個別の名前を表すNameプロパティ(read/write)と、引数で与えられた文字列をメッセージボックスで表示するSay(Message)だけを持つ簡単なクラスにする。
リスト1 クラスモジュールDekosuke
'### オブジェクト名はDekosuke ###' Option Explicit Private m_Name As String Public Property Let Name(ByVal ArgString As String) m_Name = ArgString End Property Public Property Get Name() As String Name = m_Name End Property Public Sub Say(ByVal Message As String) Dim tmp As String tmp = m_Name & "曰く、「" & Message & "」" Call MsgBox(tmp) End Sub Private Sub Class_Initialize() m_Name = "名無しさん" End Sub
見ての通り、シンプルきわまりない。
IDekosukeCallbackインターフェースを作る
次に、イベントリスナに持たせるためのインターフェースIDekosukeCallback。
リスト2 クラスモジュールIDekosukeCallback
Option Explicit
Public Sub AfterSaid(ByVal Message As String, _
Optional ByVal Speaker As String)
End Sub
これだけ。とりあえずメソッド一つだけにした。
DekosukeオブジェクトのSayメソッド実行後に実行することを想定している。
DekosukeクラスにCallbackプロパティを生やす
問題はここから。
上掲リスト1のDekosukeクラスのコードには、特にイベントを発火させるポイントはない。
そこで、このDekosukeクラスにCallbackというプロパティを生やす。
すると、リスト1は、次のようになる。
リスト1-2 クラスモジュールDekosuke
'### オブジェクト名はDekosuke ###' Option Explicit Private m_Name As String Public Callback As IDekosukeCallback '……(*)' Public Property Let Name(ByVal ArgString As String) m_Name = ArgString End Property Public Property Get Name() As String Name = m_Name End Property Public Sub Say(ByVal Message As String) Dim tmp As String tmp = m_Name & "曰く、「" & Message & "」" Call MsgBox(tmp) End Sub Private Sub Class_Initialize() m_Name = "名無しさん" End Sub
(*)の部分を追加。これでCallbackというプロパティを追加したことになる。
このCallbackプロパティ、IDekosukeCallback型にしたところがミソ。
こうすることで、IDekosukeCallbackインターフェースをImplementsしたクラスモジュールのインスタンスなら、何でもこのCallbackプロパティに突っ込めるようになったのである!
ImmWndCallbackクラスを作る
さあ、いよいよ、DekosukeクラスのCallbackプロパティに突っ込むためのクラスを作成する。
別の言い方をすれば、DekosukeオブジェクトのSayメソッド実行に反応してイミディエイトに文字列を書き出すためのクラスである。
リスト3 クラスモジュールImmWndCallback
Option Explicit
Implements IDekosukeCallback
Private Sub IDekosukeCallback_AfterSaid(Byval Speaker As String, _
ByVal Message As String)
If Speaker = "" Then Speaker = "名無しさん"
Dim tmp As String
tmp = "「" & Message & "」by " & Speaker
Debug.Print tmp
End Sub
IDekosukeCallbackインターフェースによって規定されたAfterSaidメソッドを実装。
引数MessageとSpeakerで受けとった文字列を組み合わせて、イミディエイトに出力するようにしている。
もちろん、これだけではだめ。
これに伴ってDekosukeクラスのSayメソッド側を変更せねばならない。
リスト1-3 クラスモジュールDekosuke
Public Sub Say(ByVal Message As String)
Dim tmp As String
tmp = m_Name & "曰く、「" & Message & "」"
Call MsgBox(tmp)
If Not Me.Callback Is Nothing Then '……(**)'
Call Me.Callback.AfterSaid(Message, m_Name)
End If
End Sub
Sayメソッドのメインの処理(メッセージボックスの表示)の後、AfterSaidメソッドを実行できるように、(**)からの3行
If Not Me.Callback Is Nothing Then Call Me.Callback.AfterSaid(Message, m_Name) End If
がそれ。
Callbackプロパティにイベントリスナ用のクラスのインスタンスが突っ込まれていなかったら、CallbackプロパティはNothingなので、何もしない。
Callbackプロパティにイベントリスナ用クラスのインスタンスが突っ込まれていたら、(それはIDekosukeCallback型である以上、必ずAfterSaidメソッドを持っているはずなので)ただAfterSaidメソッドを実行する、という仕掛け。
これで、まるでSayメソッドの実行を検知してAfterSaidメソッドが実行されたかのような結果が得られるのである!
使ってみる
最初に示したのと同じだが、次のコードでDekosukeクラスを使ってみる。
リスト4 標準モジュール
Private Sub testDekosuke01()
Dim ds As Dekosuke
Set ds = New Dekosuke
Set ds.Callback = New ImmWndCallback '……(***)'
Call ds.Say("ち~んw")
ds.Name = "諸葛亮"
Call ds.Say("他にすることはないのですか?")
End Sub
ポイントは、(***)のところ。
Dekosukeクラスのインスタンスdsを得た後、即座にそのCallbackプロパティにImmWndCallbackクラスのインスタンスを突っ込んでいる。
少々ひつこいが、ImmWndCallbackクラスには、IDekosukeCallbackインターフェースがImplementsされているので、IDekosukeCallback型のプロパティCallbackに突っ込めるのである。
これで、以後ds.Sayメソッドが実行されるたびにAfterSaidメソッドが呼ばれることになる。
したがって、実行すると、

画面上はこうなって、
イミディエイトは

こうなる。
おわりに
VBAの特性上、やたら数多くのクラスモジュールを使うことになってしまうが、イベントを次々に連鎖させるような処理をするなら、これも一つの面白いやり方なのではないかと思いました。