源代码如下:
--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控件中输入字符的。请各位高手指点一下。

解决方案 »

  1.   

    呵呵,你的事件处理并没有改变参数值呀!这样改下,Private 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
    KeyAscii=InfoCollection(4)'加上这句就可以了
    End Sub