模块名称:EventsHub
模块版本:V 1.1
模块介绍:
很多时候我们在窗体中会有很多类似的控件(比方说40多个TextBox),对于这些类似的控件我们需要编制类似的事件处理程序(比方说其中任何一个TextBox内容更新后重新计算结果),这种情况下,控件的事件编程会变得很复杂,比方说例子中提到的40多个TextBox,就要写40多个事件处理程序。一旦程序要作某些调整,这些代码也要作大量的调整。
现在让我们告别手工作坊的事件处理年代,采用新的事件处理方式,以下模块集中捕获对象的所有事件(包括子对象的事件)。初始化的时候(InitHub方法)指定你要集中捕获事件的控件(比方说窗体),然后当这个控件或者他的子控件有任何事件发生的时候,OnEvent方法都会被自动调用,并且传递给你三个参数:发生事件的对象名,发生事件的对象的路径(父节点),发生的事件名。你可以在代码中根据这些参数来判断到底发生了什么事件,然后决定怎么处理。
模块更新:
1、根据Trynew的建议,加入了是否覆盖窗体原有事件定义的参数,可以避免接管窗体原有的事件定义。
2、添加了事件处理端口参数,可以供用户自定义事件处理函数进行事件分类处理。(事件集线器的雏形)
3、控件类型中添加了acAllType常数。
4、截获类型被定义为一个枚举。
5、通过自动检测禁止了模块在窗体允许更改设计模式下运行
开发计划:
1、使用HookLevel替代HookType,可任意指定截获事件的对象遍历深度。
2、将使用新的端口定义方式,至多支持32个端口并发,对一个事件进行多次重复定义将不会再被覆盖,而是采用端口并行的方式,同时激活事件处理器多个端口。
3、增加事件参数的支持。
6、预告:即将推出《事件集线器EventsHub》的高端应用版本《事件配线架EventsDistributionFrame》,将全面支持事件参数,支持端口并发,全新的安全事件截获模式,并使用用户自定义事件处理函数集合,实现完全封装。
模块下载: 点击浏览该文件(为便于用户学习使用方法,本文件为包含范例的MDB文件)
![](http://www.access-cn.com/BBS/skins/default/filetype/rar.gif)
模块调用范例:
注意,请将调用本模块的窗体的“允许设计更改”属性设定为“仅设计视图”。以避免用户误操作引起的窗体数据错误。
Private Sub Form_Load()
'窗体内所有事件,包括窗体本身
InitHub Me, 0
'窗体内所有按钮
InitHub Me, 0, acCommandButton, 2
'窗体本身
InitHub Me, 0, acForm, 1
'选项卡Page1上所有的TextBox控件
InitHub Page1, 0, acAllType, 2
'选项卡Page1上所有的TextBox控件的OnGotFocus事件,但是不接管窗体原有的事件定义
InitHub Page1, 0, acAllType, ehHookMeChildren, "OnGotFocus", False
End Sub
''''''''''''''''''''''''''''''''''''''''''''''
'用户自定义函数,入口参数:
'strParent:发生事件的对象的父对象,如:窗体1
'strObject:发生事件的对象名,如:Command0
'strEvent:发生的事件名,如:OnClick
'intPort:事件自定义端口号,由初始化程序设定
''''''''''''''''''''''''''''''''''''''''''''''
Public Function OnEvent(ByVal intPort As Byte, ByVal strParents As String, ByVal strObject As String, ByVal strEvent As String)
'本函数为用户自定义函数
Debug.Print intPort & ": "; strParents & IIf(strParents = "", "", ".") & strObject & "_" & strEvent
End Function
模块源码:
Option Compare Database
Option Explicit
'扩展 acControlType
Public Const acAllType = 0
'定义 ehHookType
Public Enum ehHookType
ehHookMeChildren = 0
ehHookMe = 1
ehHookChildren = 2
End Enum
''''''''''''''''''''''''''''''''''''''''''''''''
'初始化捕获参数:
'objDest = 捕获事件的控件(可接收窗体、窗体控件)
'以下为可选参数:
'Port = 自定义事件端口号,此端口号将被传送到事件处理函数,可作为事件的用户自定义分类(默认0)
'HookDestType = 需要捕获事件的控件类型(acAllType=所有类型,默认值)
'HookType = 捕获类型(0=捕获控件事件和子控件事件,默认值
' 1=只捕获控件本身事件
' 2=只捕获子控件事件)
'EventType = 事件名(""=所有事件,默认值)
'OverWrite = 是否覆盖已有事件定义(True=覆盖,False等于不覆盖,默认False)
''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub InitHub(ByRef objDest As Object, ByVal Port As Byte, Optional ByVal HookDestType As AcControlType = 0, _
Optional ByVal HookType As ehHookType = ehHookMeChildren, Optional ByVal EventType As String = "", _
Optional ByVal OverWrite As Boolean = False)
Dim rootObject As Object
Set rootObject = objDest
Do
If TypeOf rootObject Is Form Then
If rootObject.AllowDesignChanges Then
Err.Raise 60002, "EventsHub", "本模块必须在窗体属性“允许设计更改”为“仅设计视图”模式下运行"
Else
EventsHook objDest, Port, "", HookDestType, HookType, EventType, OverWrite
End If
Exit Do
End If
Set rootObject = rootObject.Parent
Loop
End Sub
Private Sub EventsHook(ByRef objMe As Object, ByVal Port As Byte, ByVal strEventSource As String, ByVal HookDestType As AcControlType, _
ByVal HookType As ehHookType, ByVal EventType As String, Optional ByVal OverWrite As Boolean)
Dim objCtl As Access.Control
Dim objPrp As Object
Dim bolMatchType As Boolean
If HookDestType = 0 Then
bolMatchType = True
ElseIf TypeOf objMe Is Form Then
bolMatchType = (HookDestType = acForm)
Else
bolMatchType = (HookDestType = objMe.ControlType)
End If
If HookType = 1 Or HookType = 0 And bolMatchType Then
For Each objPrp In objMe.Properties
If objPrp.Name Like "On*" And (EventType = "" Or EventType = objPrp.Name) Then
If OverWrite Or objPrp.Value = "" Then objPrp.Value = "=OnEvent(" & Port & ",'" & strEventSource & "','" & objMe.Name & "','" & objPrp.Name & "')"
End If
Next objPrp
End If
If HookType = 2 Or HookType = 0 And HookDestType <> acForm Then
strEventSource = strEventSource & IIf(strEventSource = "", "", ".") & objMe.Name
On Error GoTo NoChild
For Each objCtl In objMe.Controls
EventsHook objCtl, Port, strEventSource, HookDestType, 0, EventType
Next objCtl
End If
NoChild:
Exit Sub
End Sub