VB中的对象如何在实现数组的情况下响应事件

Question

对象数组如何定义的情况下才能够响应事件。比如:
Public WithEvents Aa(5) As Class1上述语句定义错误，Class1为自定义类，但Public Aa(5) As Class1定义成功但不能响应事件？？？？？？？

Answer 1

MSDN会告诉你答案的：不能创建 WithEvents 变量数组。

Answer 2

http://community.csdn.net/Expert/topic/4643/4643752.xml?temp=.4438745

Answer 3

一个窗体:Option Explicit'Declare a few textbox object arrays
Private mobjBox1Array() As clsControl
Private mobjBox2Array() As clsControl
Private mobjSingle As clsControl'Declare a few button object arrays
Private mobjBut1Array() As clsControl
Private mobjBut2Array() As clsControl'Implement the control interface
Implements IControlPrivate Sub Form_Load()
   Dim fWidth As Single
   Dim fHeight As Single
   
   'Size and Center the form
   fWidth = (Me.Width - Me.ScaleWidth) + (230 * Screen.TwipsPerPixelX)
   fHeight = (Me.Height - Me.ScaleHeight) + (300 * Screen.TwipsPerPixelY)
   With Me
      .Move (Screen.Width - fWidth) \ 2, (Screen.Height - fHeight) \ 2, fWidth, fHeight
   End With
   
   'Build the UI
   Call BuildUI
   
End SubPrivate Sub BuildUI()
   Dim c As TextBox
   Dim d As CommandButton
   Dim i As Integer
   
   'Set up a few arrays
   ReDim mobjBox1Array(4)
   ReDim mobjBox2Array(4)
   
   ReDim mobjBut1Array(4)
   ReDim mobjBut2Array(4)
   
   'Fill "Array1"
   For i = 0 To 4
      'Instantiate the class
      Set mobjBox1Array(i) = New clsControl
      
      'Add the control to the form
      Set c = mobjBox1Array(i).AddControl(Me, Me, ctTextBox, "Array1", i)
      'Move it into place and make it Visible
      With c
         .Move 120, i * 375, 1500, 315
         .Visible = True
      End With
      
      'BUTTON
      
      'Instantiate the class
      Set mobjBut1Array(i) = New clsControl
      'Add the control to the form
      Set d = mobjBut1Array(i).AddControl(Me, Me, ctCommandButton, "BArray1", i)
      'Move it into place and make it Visible
      With d
         .Move 120, 2500 + i * 375, 1500, 315
         .Visible = True
      End With
   
   Next
   
   'Fill "Array2"
   For i = 0 To 4
      'Instantiate the class
      Set mobjBox2Array(i) = New clsControl
      
      'Add the control to the form
      Set c = mobjBox2Array(i).AddControl(Me, Me, ctTextBox, "Array2", i)
      'Move it into place and make it Visible
      With c
         .Move 1750, i * 375, 1500, 315
         .Visible = True
      End With
   
      'BUTTON
      
      'Instantiate the class
      Set mobjBut2Array(i) = New clsControl
      
      'Add the control to the form
      Set d = mobjBut2Array(i).AddControl(Me, Me, ctCommandButton, "BArray2", i)
      'Move it into place and make it Visible
      With d
         .Move 1750, 2500 + i * 375, 1500, 315
         .Visible = True
      End With
   
   Next
   
   'Add a single textbox
   
   'Add the control to the form
   'Instantiate the class
   Set mobjSingle = New clsControl
   Set c = mobjSingle.AddControl(Me, Me, ctTextBox)
   'Move it into place and make it Visible
   With c
      .Move 880, 2000, 1500, 315
      .Visible = True
   End WithEnd SubPrivate Sub IControl_Change(ByVal EvtSource As clsControl)
   Debug.Print "IControl_Change", EvtSource.ArrayID, EvtSource.Index
   Debug.Print EvtSource.TextBoxObject.Text
End SubPrivate Sub IControl_Click(ByVal EvtSource As clsControl)
   Debug.Print "IControl_Click", EvtSource.ArrayID, EvtSource.Index
   
   'This code's just showing a way to determine which button
   'was clicked and how to manipulate a controls properties
   '
   'Clicked a member of the "BArray1" command button group?
   If EvtSource.ArrayID = "BArray1" Then
      'If so, toggle the visibility of the corresponding textbox
      With mobjBox1Array(EvtSource.Index).TextBoxObject
         .Visible = Not .Visible
      End With
   End If
   
End SubPrivate Sub IControl_GotFocus(ByVal EvtSource As clsControl)
   Debug.Print "IControl_GotFocus", EvtSource.ArrayID, EvtSource.Index
   If EvtSource.ControlType = ctCommandButton Then
      EvtSource.ButtonObject.Caption = Timer
   Else
      With EvtSource.TextBoxObject
         .SelStart = 0
         .SelLength = Len(.Text)
      End With
   End If
End SubPrivate Sub IControl_LostFocus(ByVal EvtSource As clsControl)
   Debug.Print "IControl_LostFocus", EvtSource.ArrayID, EvtSource.Index
   If EvtSource.ControlType = ctTextBox Then
      With EvtSource.TextBoxObject
         .Text = UCase$(.Text)
      End With
   End If
End Sub

Answer 4

//接上
两个类模块:类模块IControl:
Option Explicit'Place subs for each event you want to support in this class
'There's no use adding code here because it will never run
'This is just an interface that the form implements
'
'If you've never used Implemented Interfaces before, now's
'a good time to start.
'Keep in mind that, for each of these interfaces, there must
'be a supporting procedure in the form that Implements this
'Even if the procedure contains only a single comment 
'like the ones below, it must exist.
'If you forget to add code to the form's copy of this procedure,
'you'll get a compiler error that tells you the name of the method
'you forgot
Public Sub Change(ByVal EvtSource As clsControl)
   '
End SubPublic Sub Click(ByVal EvtSource As clsControl)
   '
End SubPublic Sub GotFocus(ByVal EvtSource As clsControl)
   '
End SubPublic Sub LostFocus(ByVal EvtSource As clsControl)
   '
End Sub类模块clsControl:
Option Explicit'Public Property Variables
Private mobjInterface As IControl
Private miIndex As Integer
Private msArrayID As String
Private meControlType As ControlTypes'A list of controls that require support
Private WithEvents mobjButton As CommandButton
Private WithEvents mobjTBox As TextBox'The types of controls above
Public Enum ControlTypes
   ctInvalidType
   ctTextBox
   ctCommandButton
End Enum'Remaining declarations are for GUID creation (AddControl Method)
Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As String * 1
End TypePrivate Declare Function CoCreateGuid _
                Lib "ole32.dll" (tGUIDStructure As GUID) As Long
Private Declare Function StringFromGUID2 _
                Lib "ole32.dll" (rguid As Any, _
                                 ByVal lpstrClsId As Long, _
                                 ByVal cbMax As Long) As LongPublic Function AddControl(ByRef Frm As Form, _
                           ByRef CInterface As IControl, _
                           ByVal ControlType As ControlTypes, _
                           Optional ByVal ArrayName As String, _
                           Optional ByVal Index As Integer = -1) As Control
   Static bHere As Boolean
   
   If Not bHere Then
      bHere = True
      
      Set mobjInterface = CInterface
      
      msArrayID = ArrayName
      miIndex = Index
      
      Select Case ControlType
         Case ControlTypes.ctTextBox
            Set mobjTBox = Frm.Controls.Add("VB.TextBox", "c" & GenateID)
            meControlType = ctTextBox
            Set AddControl = mobjTBox
            
         Case ControlTypes.ctCommandButton
            Set mobjButton = Frm.Controls.Add("VB.CommandButton", "c" & GenateID)
            meControlType = ctCommandButton
            Set AddControl = mobjButton
         
         Case Else
            meControlType = ctInvalidType
            Err.Raise 13
      End Select
   Else
      'Since this method can only be called once, raise an error
      Err.Raise 360, "AddControl", "Object Already Loaded"
   End If
   
End FunctionPublic Property Get ArrayID() As String
   ArrayID = msArrayID
End PropertyPublic Property Get ButtonObject() As CommandButton
   'Allows direct access to the commandbutton object
   Set ButtonObject = mobjButton
End PropertyPublic Property Get ControlObject() As Control
   'This property gives a way to get generic
   'control information without knowing
   'the type of control
   Select Case meControlType
      Case ctCommandButton
         Set ControlObject = mobjButton
      Case ctTextBox
         Set ControlObject = mobjTBox
   End Select
End PropertyPublic Property Get TextBoxObject() As TextBox
   'Allows direct access to the textbox object
   Set TextBoxObject = mobjTBox
End PropertyPublic Property Get ControlType() As ControlTypes
   ControlType = meControlType
End PropertyPublic Property Get Index() As Integer
   Index = miIndex
End Property'Overhead code
Private Function GenateID() As String   Const clLen As Long = 50   Dim sGUID   As String       'store result here
   Dim tGUID   As GUID         'get into this structure
   Dim bGuid() As Byte         'get formatted string here
   Dim lRtn    As Long   If CoCreateGuid(tGUID) = 0 Then                             'use API to get the GUID
      bGuid = String(clLen, 0)
      lRtn = StringFromGUID2(tGUID, VarPtr(bGuid(0)), clLen)  'use API to
      'Format it
      If lRtn > 0 Then                                        'truncate nulls
         sGUID = Mid$(bGuid, 1, lRtn - 1)
      End If
      'Strip extra stuff off of the GUID
      sGUID = Replace(sGUID, "{", "")
      sGUID = Replace(sGUID, "}", "")
      sGUID = Replace(sGUID, "-", "")
      GenateID = sGUID
   End IfEnd FunctionPrivate Sub Class_Terminate()
   Set mobjButton = Nothing
   Set mobjTBox = Nothing
End Sub'*************************************
'*****Command Button Events
'*************************************
Private Sub mobjButton_Click()
   Call mobjInterface.Click(Me)
End SubPrivate Sub mobjButton_GotFocus()
   Call mobjInterface.GotFocus(Me)
End SubPrivate Sub mobjButton_LostFocus()
   Call mobjInterface.LostFocus(Me)
End Sub'*************************************
'*****Textbox Events
'*************************************
Private Sub mobjTBox_Change()
   Call mobjInterface.Change(Me)
End SubPrivate Sub mobjTBox_GotFocus()
   'Do some stuff to the control before running code in the form
   mobjTBox.BackColor = RGB(Rnd * 127, Rnd * 127, Rnd * 127)
   mobjTBox.ForeColor = vbWhite
   Call mobjInterface.GotFocus(Me)
End SubPrivate Sub mobjTBox_LostFocus()
   'Do some stuff to the control before running code in the form
   mobjTBox.BackColor = vbWindowBackground
   mobjTBox.ForeColor = vbWindowText
   Call mobjInterface.LostFocus(Me)
End Sub