事件触发

一、事件触发方式

WithEvents：传统方式，只能在类里使用，声明变量时WithEvents关键字

CallBack：只能在标准模块里使用，用黑科技在类里使用的技术，不在此文讨论范围

IEvents：接口方式，只能在类里使用，触发发生更灵活

二、WithEvents

例如在Form里

Private WithEvents oEvents As loquatEvent.Events
Private WithEvents oEvent As loquatEvent.EventInfo

Dim pe As String
Dim lCookie As Long

Private Sub cmdAPI_Click(index As Integer)
    pe = App.Path & "\Build\NewProject_win32.dll"
    Select Case index
        Case 0  '测试导出函数
            testAPI
        Case 1  '测试EventApp方法
            testMethod
        Case 2  '测试EventApp接口回调
            testIGenericEventHandler
        Case 3  '测试Events对象事件，测试一个事件接口的所有事件
            testEvents
        Case 4  '测试EventInfo对象事件，测试一个事件接口的单个事件
            testEvent
    End Select
End Sub

Sub testEvents()   '从Events对象触发事件
    Dim o As Object
    Dim c As loquatEvent.EventApp
    Set c = CreateObject("loquatEvent.EventApp")
    
    Dim oInfo As loquatEvent.ObjectInfo
    
    Set o = CreateObjectEx(pe, "cshowmsgbox")
    Set oInfo = c.Add("Key1", o)
    
    'vb6/vba里虽然只能支持一个默认接口的Interface和EventInterface
    '但是其他语言写的tlb，可以用Interfaces和EventInterfaces解析，并且可以触发事件
    '包括几个导出函数也支持多接口成员和多事件接口事件
    
    Dim oEventIfc As loquatEvent.EventInterface
    Set oEventIfc = oInfo.EventInterfaces(1)
    Set oEvents = oEventIfc.Events
    Debug.Print oEvents.Advise  '绑定后期事件
    o.ShowMsgBox "test"   '触发后期事件
End Sub

Sub testEvent()   '从EventInfo对象触发事件
    Dim o As Object
    Dim c As Object
    Set c = CreateObject("loquatEvent.EventApp")
    Dim oInfo As loquatEvent.ObjectInfo
    Set o = CreateObjectEx(pe, "cshowmsgbox")
    Set oInfo = c.Add("Key1", o)
    '简写了
    Set oEvent = oInfo.EventInterfaces(1).Events(1)
    Debug.Print oEvent.Advise  '绑定事件
    o.ShowMsgBox "test"   '触发后期事件
End Sub

'EventInfo对象触发的事件
Private Sub oEvent_OnEventOne(ByVal objInfo As loquatEvent.IObjectInfo, ByVal evtInfo As loquatEvent.IEventInfo, ByVal Cookie As Long)
    Dim oParams As loquatEvent.Parameters
    Set oParams = evtInfo.Parameters
    If oParams(1).ByRef = True Then
        oParams(1).Value = "单个事件WithEvents成功"
    End If
End Sub

'Events对象触发的事件
Private Sub oEvents_OnEventAll(ByVal objInfo As loquatEvent.IObjectInfo, ByVal evtInfo As loquatEvent.IEventInfo, ByVal Cookie As Long)
    Dim oParams As loquatEvent.Parameters
    Set oParams = evtInfo.Parameters
    If oParams(1).ByRef = True Then
        oParams(1).Value = "多个事件WithEvents成功"
    End If
End Sub

三、CallBack：

Dim pe As String
Dim lCookie As Long

Private Sub cmdAPI_Click(index As Integer)
    pe = App.Path & "\Build\NewProject_win32.dll"
    Select Case index
        Case 0  '测试导出函数
            testAPI
        Case 1  '测试EventApp方法
            testMethod
        Case 2  '测试EventApp接口回调
            testIGenericEventHandler
        Case 3  '测试Events对象事件，测试一个事件接口的所有事件
            testEvents
        Case 4  '测试EventInfo对象事件，测试一个事件接口的单个事件
            testEvent
    End Select
End Sub

Sub testAPI()   '用导出函数触发事件回调
    Dim o As Object
    Set o = CreateObjectEx(pe, "cshowmsgbox")
    lCookie = SetEventCallback(o, AddressOf BeforeShowMsgBox, "beforeshowmsgbox")  '绑定单个事件到回调函数 BeforeShowMsgBox
    o.ShowMsgBox "this is a test"  '调用ShowMsgBox方法，会触发BeforeShowMsgBox事件
    UnbindEvent lCookie            '用完需要卸载事件绑定
    lCookie = SetGenericEventCallback(o, AddressOf GenericCallBack)  '绑定所有事件到通用回调函数 GenericCallBack
    o.ShowMsgBox "this is a test"  '调用方法，会触发所有相关事件
End Sub

Sub testMethod()  '用EventApp对象的方法绑定事件到回调函数
    Dim o As Object
    Dim c As Object
    Set c = CreateObject("loquatEvent.EventApp")
    Set o = c.CreateObjectEx(pe, "cshowmsgbox")
    lCookie = c.SetEventCallback(o, AddressOf BeforeShowMsgBox, "beforeshowmsgbox")
    o.ShowMsgBox "this is a test"  '调用ShowMsgBox方法，会触发BeforeShowMsgBox事件
    c.UnbindEvent lCookie
    lCookie = c.SetGenericEventCallback(o, AddressOf GenericCallBack)
    o.ShowMsgBox "this is a test"
End Sub

'通用事件回调，除了Event名之外，其他所有信息都包含在第2个参数sParamJson里，可以回写参数
Public Sub GenericCallBack(ByVal sEventName As String, ByRef sParamsJson As String)
    Dim js As JsonBag
    Set js = New JsonBag
    js.json = sParamsJson
    js(1)("value") = "通用回调测试成功"
    sParamsJson = js.json
End Sub

'单个事件回调
Public Sub BeforeShowMsgBox(sNewMessage As String, bCancel As Boolean)
    sNewMessage = "单个回调测试成功"
    bCancel = False ' Set True to cancel showing the MsgBox
End Sub
'回调签名通过以下方式获取：
'1、导出函数GetSignatures导出函数
'  Debug.Print GetSignatures(obj, 0, "BeforeShowMsgBox")  '0-VB, 1=C, 2=JSON
'              这里还设有第4个参数指定Event接口IID或者名称，在VB6/VBA里一般用不上
'2、EventApp对象的GetSinatures成员，调用方式同上
'3、Events.Signatures方法
'  Debug.Print objEventApp.Signatures(0, "BeforeShowMsgBox")
'4、EventInfo.Signature方法
'  Debug.Print objEventInfo.Signature(0)

四、IGenericEvents接口触发事件

写在类（cls/frm/dob/ctl）里的代码

Implements IGenericEvents

Dim pe As String
Dim lCookie As Long

Private Sub cmdAPI_Click(index As Integer)
    pe = App.Path & "\Build\NewProject_win32.dll"
    Select Case index
        Case 0  '测试导出函数
            testAPI
        Case 1  '测试EventApp方法
            testMethod
        Case 2  '测试EventApp接口回调
            testIGenericEventHandler
        Case 3  '测试Events对象事件，测试一个事件接口的所有事件
            testEvents
        Case 4  '测试EventInfo对象事件，测试一个事件接口的单个事件
            testEvent
    End Select
End Sub

Sub testIGenericEventHandler()
    Dim o As Object
    Set o = CreateObjectEx(pe, "cshowmsgbox")
    SetIGenericEventHandler o, Me   '绑定事件到接口Me对象的接口上
    o.ShowMsgBox "this is a test"
End Sub

'接口方式暂时只实现了通用回调方式，类似于SetGenericEventCallBack，第2个参数是ByRef Json
'对标SetEventCallBack对应的SetEventHandler方法暂时没有实现
'因为有难度，没有继续研究了，实际上绝大部分并不知道在VB6/VBA里怎么写接口、玩接口
Private Sub IGenericEvents_OnEvent(ByVal eventName As String, paramsJson As String)
    Dim js As JsonBag
    Set js = New JsonBag
    js.json = paramsJson
    js(1)("value") = "接口回调测试成功"
    paramsJson = js.json
End Sub