Custom EventをCallbackに変える

Custom EventをCallbackに変える

クラスモジュールを用いて作ったオブジェクトには、イベントを持たせることができる。

akashi-keirin.hatenablog.com

今回は、このCustom Eventと同様のことを、別のやり方でやってみる。

Custom Eventの場合は、EventRaiseEventWithEventsという三つのキーワードを用いましたが、今度はインターフェース用のクラスモジュールと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

こんなコードを実行するだけで、

f:id:akashi_keirin:20201230111838g:plain

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

f:id:akashi_keirin:20201230111901j:plain

こんな風に出力させることができる。

上掲コード中、DekosukeクラスのインスタンスdsSayメソッドを実行したときに、あたかもイベントが発生したかのように、イミディエイトに文字列が出力されたのである。

もちろん、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プロパティを生やす

問題はここから。

上掲リスト1Dekosukeクラスのコードには、特にイベントを発火させるポイントはない。

そこで、この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メソッドを実装。

引数MessageSpeakerで受けとった文字列を組み合わせて、イミディエイトに出力するようにしている。

もちろん、これだけではだめ。

これに伴って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メソッドが呼ばれることになる。

したがって、実行すると、

f:id:akashi_keirin:20201230111838g:plain

画面上はこうなって、

イミディエイトは

f:id:akashi_keirin:20201230111901j:plain

こうなる。

おわりに

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