源代码如下:
--ControlEvents.clsOption Explicit
Public Event ObjectEvents(Info As Collection)
Friend Sub RaiseCtrlEvent(Info As Collection)
RaiseEvent ObjectEvents(Info)
End Sub--VBCtrlExt.cls
Option Explicit
'在这个类里捕获控件的事件,对于CommandButton,TextBox等VB内置的空件,每个事件
'都要单独实现,对于ListView等引用的空件,用VBControlExtender同一实现
'这里只处理了CommandButton的一个事件和TextBox的几个事件,其他的事件,和其它
'VB内置空件的事件,请依照相同的方式自行添加
Dim WithEvents m_VBCtrlExt As VBControlExtender
Dim WithEvents m_VBCtrlTxt As TextBox
Dim WithEvents m_VBCtrlBtn As CommandButton
Dim WithEvents m_VBCtrlCbo As ComboBox
Dim m_ControlEvents As ControlEventsPublic Sub SetControl(Ctrl As Control, CtrlEvns As ControlEvents)
Select Case TypeName(Ctrl)
Case "TextBox"
Set m_VBCtrlTxt = Ctrl
Case "CommandButton"
Set m_VBCtrlBtn = Ctrl
Case "ComboBox"
Set m_VBCtrlCbo = Ctrl
Case Else
Set m_VBCtrlExt = Ctrl
End Select
Set m_ControlEvents = CtrlEvns
End SubPrivate Sub Class_Terminate()
Set m_VBCtrlExt = Nothing
Set m_VBCtrlTxt = Nothing
Set m_VBCtrlBtn = Nothing
Set m_VBCtrlCbo = Nothing
Set m_ControlEvents = Nothing
End SubPrivate Sub m_VBCtrlBtn_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlBtn, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlCbo_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlCbo_KeyDown(KeyCode As Integer, Shift As Integer)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "KeyDown", "Name"
InfoCollection.Add "KeyCode", "Parameter1Name"
InfoCollection.Add KeyCode, "Parameter1Value"
InfoCollection.Add "Shift", "Parameter2Name"
InfoCollection.Add Shift, "Parameter2Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlCbo_KeyPress(KeyAscii As Integer)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "KeyPress", "Name"
InfoCollection.Add "KeyAscii", "Parameter1Name"
InfoCollection.Add KeyAscii, "Parameter1Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlExt_ObjectEvent(Info As EventInfo)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlExt, "Control"
InfoCollection.Add Info.Name, "Name"
For Each p In Info.EventParameters
i = i + 1
InfoCollection.Add p.Name, "Parameter" & i & "Name"
InfoCollection.Add p.Value, "Parameter" & i & "Value"
Next
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_Change()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "Change", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlTxt_DblClick()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "DblClick", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlTxt_DragDrop(Source As Control, X As Single, Y As Single)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "DragDrop", "Name"
InfoCollection.Add "Source", "Parameter1Name"
InfoCollection.Add Source, "Parameter1Value"
InfoCollection.Add "X", "Parameter2Name"
InfoCollection.Add X, "Parameter2Value"
InfoCollection.Add "Y", "Parameter3Name"
InfoCollection.Add Y, "Parameter3Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_GotFocus()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "GotFocus", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "MouseDown", "Name"
InfoCollection.Add "Button", "Parameter1Name"
InfoCollection.Add Button, "Parameter1Value"
InfoCollection.Add "Shift", "Parameter2Name"
InfoCollection.Add Shift, "Parameter2Value"
InfoCollection.Add "X", "Parameter3Name"
InfoCollection.Add X, "Parameter3Value"
InfoCollection.Add "Y", "Parameter4Name"
InfoCollection.Add Y, "Parameter4Value"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd Sub--form1.frm
Option Explicit
Dim CtrlCollection As New Collection
Dim WithEvents CtrlEvns As ControlEvents
Private Sub Form_Load()
Dim v As VBCtrlExt, b As Control
Controls.Add "VB.ComboBox","Combo1"
Set CtrlEvns = New ControlEvents
Set v = New VBCtrlExt
v.SetControl Controls("Combo1"), CtrlEvns
CtrlCollection.Add v
End Sub Private Sub CtrlEvns_ObjectEvents(Info As Collection)
If Info(1).name="Combo1" and Info(2)="KeyPress" then
Info.remove 4 '将参数从集合中删除
Info.add 0,"Parameter1Value" '将参数加入集合(从而改变参数的值)
End If
End Sub
按照上面的方法在事件中的参数的值是改变了,但还是可以在combobox控件中输入字符的。请各位高手指点一下。
--ControlEvents.clsOption Explicit
Public Event ObjectEvents(Info As Collection)
Friend Sub RaiseCtrlEvent(Info As Collection)
RaiseEvent ObjectEvents(Info)
End Sub--VBCtrlExt.cls
Option Explicit
'在这个类里捕获控件的事件,对于CommandButton,TextBox等VB内置的空件,每个事件
'都要单独实现,对于ListView等引用的空件,用VBControlExtender同一实现
'这里只处理了CommandButton的一个事件和TextBox的几个事件,其他的事件,和其它
'VB内置空件的事件,请依照相同的方式自行添加
Dim WithEvents m_VBCtrlExt As VBControlExtender
Dim WithEvents m_VBCtrlTxt As TextBox
Dim WithEvents m_VBCtrlBtn As CommandButton
Dim WithEvents m_VBCtrlCbo As ComboBox
Dim m_ControlEvents As ControlEventsPublic Sub SetControl(Ctrl As Control, CtrlEvns As ControlEvents)
Select Case TypeName(Ctrl)
Case "TextBox"
Set m_VBCtrlTxt = Ctrl
Case "CommandButton"
Set m_VBCtrlBtn = Ctrl
Case "ComboBox"
Set m_VBCtrlCbo = Ctrl
Case Else
Set m_VBCtrlExt = Ctrl
End Select
Set m_ControlEvents = CtrlEvns
End SubPrivate Sub Class_Terminate()
Set m_VBCtrlExt = Nothing
Set m_VBCtrlTxt = Nothing
Set m_VBCtrlBtn = Nothing
Set m_VBCtrlCbo = Nothing
Set m_ControlEvents = Nothing
End SubPrivate Sub m_VBCtrlBtn_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlBtn, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlCbo_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlCbo_KeyDown(KeyCode As Integer, Shift As Integer)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "KeyDown", "Name"
InfoCollection.Add "KeyCode", "Parameter1Name"
InfoCollection.Add KeyCode, "Parameter1Value"
InfoCollection.Add "Shift", "Parameter2Name"
InfoCollection.Add Shift, "Parameter2Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlCbo_KeyPress(KeyAscii As Integer)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "KeyPress", "Name"
InfoCollection.Add "KeyAscii", "Parameter1Name"
InfoCollection.Add KeyAscii, "Parameter1Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlExt_ObjectEvent(Info As EventInfo)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlExt, "Control"
InfoCollection.Add Info.Name, "Name"
For Each p In Info.EventParameters
i = i + 1
InfoCollection.Add p.Name, "Parameter" & i & "Name"
InfoCollection.Add p.Value, "Parameter" & i & "Value"
Next
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_Change()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "Change", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_Click()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "Click", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlTxt_DblClick()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "DblClick", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd SubPrivate Sub m_VBCtrlTxt_DragDrop(Source As Control, X As Single, Y As Single)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "DragDrop", "Name"
InfoCollection.Add "Source", "Parameter1Name"
InfoCollection.Add Source, "Parameter1Value"
InfoCollection.Add "X", "Parameter2Name"
InfoCollection.Add X, "Parameter2Value"
InfoCollection.Add "Y", "Parameter3Name"
InfoCollection.Add Y, "Parameter3Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_GotFocus()
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "GotFocus", "Name"
m_ControlEvents.RaiseCtrlEvent InfoCollection
End SubPrivate Sub m_VBCtrlTxt_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlTxt, "Control"
InfoCollection.Add "MouseDown", "Name"
InfoCollection.Add "Button", "Parameter1Name"
InfoCollection.Add Button, "Parameter1Value"
InfoCollection.Add "Shift", "Parameter2Name"
InfoCollection.Add Shift, "Parameter2Value"
InfoCollection.Add "X", "Parameter3Name"
InfoCollection.Add X, "Parameter3Value"
InfoCollection.Add "Y", "Parameter4Name"
InfoCollection.Add Y, "Parameter4Value"
m_ControlEvents.RaiseCtrlEvent InfoCollectionEnd Sub--form1.frm
Option Explicit
Dim CtrlCollection As New Collection
Dim WithEvents CtrlEvns As ControlEvents
Private Sub Form_Load()
Dim v As VBCtrlExt, b As Control
Controls.Add "VB.ComboBox","Combo1"
Set CtrlEvns = New ControlEvents
Set v = New VBCtrlExt
v.SetControl Controls("Combo1"), CtrlEvns
CtrlCollection.Add v
End Sub Private Sub CtrlEvns_ObjectEvents(Info As Collection)
If Info(1).name="Combo1" and Info(2)="KeyPress" then
Info.remove 4 '将参数从集合中删除
Info.add 0,"Parameter1Value" '将参数加入集合(从而改变参数的值)
End If
End Sub
按照上面的方法在事件中的参数的值是改变了,但还是可以在combobox控件中输入字符的。请各位高手指点一下。
解决方案 »
- 串口接收问题 在线等
- 请问怎样将VSFlexGrid数据导入EXCEL
- 关于vb自带报表设计器的问题??
- 如何使编制的应用程序可以查找硬盘里的文件?
- VB图形编程!GUI系统,基于数据库画图,鼠标图形操作,放大缩小,滚屏,打印。1000分。
- "!"是什么意思????
- vb6.0至vb.net长度单位的比列是?
- 完全用ado代码添加记录问题?????
- 为什么在客户端不能连接服务器端的sql server数据库
- VB6.0 加载(loadlayout) Rpx问件时,如何修改rpx中的数据源?
- 为什么重新装系统后,运行程序提示"不能在该主机应用程序中从ActiveX DLL....显示非模式窗体"
- 怎么实现多个datagrid相关连?
Dim InfoCollection As New Collection, p As EventParameter, i As Long
InfoCollection.Add m_VBCtrlCbo, "Control"
InfoCollection.Add "KeyPress", "Name"
InfoCollection.Add "KeyAscii", "Parameter1Name"
InfoCollection.Add KeyAscii, "Parameter1Value"
m_ControlEvents.RaiseCtrlEvent InfoCollection
KeyAscii=InfoCollection(4)'加上这句就可以了
End Sub