Dynamic 在VB6运行时向窗体上的每个控件添加事件处理程序

我有一个VB6应用程序，我希望它的控件在应用程序范围内保持一致的行为。例如，其中一种行为是在文本框获得焦点时高亮显示，在失去焦点时删除高亮显示。我希望这种情况发生在每一张表格上

我想做的是有一个子过程，所有表单在加载时都可以调用它，这将使这种行为发生。这样，我就不必为每个单独的文本框手动编码以使其高亮显示

我曾尝试让VB6在运行时将事件处理程序附加到控件上，但它只是对我咆哮。我来自.Net背景，所以可能我对VB6的理解是错误的。但是，如何才能在不必为每个控件手动编码的情况下获得所需的行为呢？

请查看：

---

执行您要求的操作的适当方法是定义一个新的UserControl（

MyAdvancedTextBox

）并在其中编码您的预期行为。然后用该用户控件替换所有文本框。这是一个很大的工作，但比另一个工作要少：

在代码隐藏中为每个文本框（或文本框控制数组）手动定义事件处理程序，并将事件处理程序自身传递给执行公共处理逻辑的某个公共模块子例程

VB6事件比.NET更原始。

您也可以。这里的优点是，您可以在一个地方编写高亮显示和反高亮显示代码，而无需遍历并替换所有现有控件（如Scott所建议的）

---

缺点是您必须向所有表单的Form_Load事件中添加代码以“注册”该表单上的控件。然而，如果您想将该技术应用于每个控件，即使这样也不应该太糟糕；在这种情况下，您只需要编写一个函数，在表单的

.Controls

集合中循环并注册每个控件。然后在每个表单的form_Load事件中调用此函数。

不幸的是，VB6不支持实现继承，您不能继承TextBox，只能修改或添加功能。它也不支持COM聚合，尽管我怀疑ActiveX控件规范也支持它

剩下的就是从头开始重新实现一个控件，或者实现一个包含原始控件的自定义UserControl，并转发每个方法、属性或事件。后一种方法的问题不在于它有很多无意义的代码，而在于VB6的自定义用户控件的性能。内置控件速度非常快，您可以在发现降级之前放置数百个标签或文本框

在像您这样的情况下，我要做的是实现一个扩展程序类，该类保存对textbox控件的引用，对其进行子类化和/或侦听并响应控件引发的事件。extender类在GetFocus事件或WM_GetFocus上实现所需/修改的行为。接下来，对于表单上的每个文本框，使用对控件的引用初始化一个扩展程序实例。所有扩展程序都保存在一个集合中，该集合可以是扩展表单本身的类的一部分。表单扩展程序可以包装控件扩展程序的实例化和初始化（用于控件中的每个部分）

---

我一直在这样做，在表单上放置的每个控件都有非常丰富的扩展程序，这些控件封装了我访问的每个属性/方法。我也只在扩展器上监听事件。很好的一点是，当我在第三方控件中发现bug时，我可以在控件扩展程序中很容易地缓解它。

实现所需行为的另一种方法是根本不处理文本框事件。相反，设置一个计时器控件，设置一个小的滴答间隔，比如50毫秒。在勾选事件中，检查Me.ActiveControl以查看焦点是否已移动，并相应地高亮显示/取消高亮显示。您需要一个静态变量来记住哪个控件具有焦点

---

这是在VB6中获取通用GotFocus/LostFocus事件处理程序的一种非常简单的方法。

由于本网站的提示，我自己也有了扩展程序的想法，我想出了自己的解决方案：

类别clsTextBoxExtender定义：

Public WithEvents Control As TextBox

Private Sub Control_GotFocus()
    Control.SelStart = 0
    Control.SelLength = Len(Control.Text)
End Sub

Private Sub Control_LostFocus()
    Control.SelLength = 0
End Sub

Public Sub InitialiseTextBoxExtenders(ByRef myForm As Form, ByRef extenderCollection As Collection)
    Dim formControl As Control
    Dim oTBXExtender As clsTextBoxExtender
    For Each formControl In myForm.Controls
        If TypeOf formControl Is TextBox Then
            Set oTBXExtender = New clsTextBoxExtender
            Set oTBXExtender.Control = formControl
            extenderCollection.Add oTBXExtender
        End If
     Next
End Sub

模块1定义：

Public WithEvents Control As TextBox

Private Sub Control_GotFocus()
    Control.SelStart = 0
    Control.SelLength = Len(Control.Text)
End Sub

Private Sub Control_LostFocus()
    Control.SelLength = 0
End Sub

Public Sub InitialiseTextBoxExtenders(ByRef myForm As Form, ByRef extenderCollection As Collection)
    Dim formControl As Control
    Dim oTBXExtender As clsTextBoxExtender
    For Each formControl In myForm.Controls
        If TypeOf formControl Is TextBox Then
            Set oTBXExtender = New clsTextBoxExtender
            Set oTBXExtender.Control = formControl
            extenderCollection.Add oTBXExtender
        End If
     Next
End Sub

表格1定义：

Private textBoxExtenderCollection As New Collection

Private Sub Form1_Load()
    Module1.InitialiseTextBoxExtenders Me, textBoxExtenderCollection
End Sub

'No longer required
'Private Sub TextBox1_GotFocus()
'    TextBox1.SelStart = 0
'    TextBox1.SelLength = Len(TextBox1.Text)
'End Sub

因此，实际上，对于每个新表单，您所要做的就是声明一个集合并在form load事件中调用初始化器代码。简单

此外，如果您有进一步的要求，需要引用回extender类，而不是在集合中循环，您可以选择在添加到集合时创建控件名称的键，但是请记住，如果您在表单上使用控件数组，则表单可能需要在键中包含索引

---

另请注意，如果在窗体中为控件声明相同的事件，则事件和扩展程序事件将依次触发。我不知道这方面的任何文档，但是，从我的实验来看，extender事件是最后一个事件。

提示很好。然而，共享的示例非常有限。 我对动态控件的事件有问题。 我必须创建复选框，文本框，单选按钮和组合框点击一个按钮。我能够成功创建动态控件。 但是我无法捕获每个控件的操作，例如更改复选框或单选选项的状态或下拉文本中的更改

添加代码以供参考： 期望值：
1.我应该能够在复选框中捕获删除行更改
2.我应该能够捕获组合框中的更改

静态控件：
1.形式：FRMC特征
2.按钮：cmdAddCharacteristics
3.SSTab:tabDisplay

模块1中的代码：

Public SR_NO As Long
Public Top_Position As Long

FRMCharacteristics中的代码

Option Explicit
Dim WithEvents Ch_Delete_Row As CheckBox
Dim WithEvents Ch_SR_NO As Label
Dim WithEvents Ch_Name As TextBox
Dim WithEvents Ch_Type As ComboBox

Dim WithEvents Extended_Control As VBControlExtender


Private Sub cmdAddCharacteristics_Click()

    Module1.SR_NO = Module1.SR_NO + 1
    Set Ch_Delete_Row = frmCharacteristics.Controls.Add("VB.CheckBox", "Ch_Delete_Row" & (Module1.SR_NO), tabDisplay)
    Ch_Delete_Row.Visible = True
    Ch_Delete_Row.Top = Module1.Top_Position + 100
    Ch_Delete_Row.Width = 1000
    Ch_Delete_Row.Left = 500
    Ch_Delete_Row.Caption = ""
    Ch_Delete_Row.Height = 315
    'MsgBox Ch_Delete_Row.Name

    Set Ch_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Ch_SR_NO" & (Module1.SR_NO), tabDisplay)
    Ch_SR_NO.Visible = True
    Ch_SR_NO.Top = Module1.Top_Position + 200
    Ch_SR_NO.Width = 750
    Ch_SR_NO.Left = Ch_Delete_Row.Left + Ch_Delete_Row.Width + 400
    Ch_SR_NO.Caption = Module1.SR_NO
    Ch_SR_NO.Height = 315

    Set Ch_Name = frmCharacteristics.Controls.Add("VB.TextBox", "Ch_Name" & (Module1.SR_NO), tabDisplay)
    Ch_Name.Visible = True
    Ch_Name.Top = Module1.Top_Position + 100
    Ch_Name.Width = 2000
    Ch_Name.Left = Ch_SR_NO.Left + Ch_SR_NO.Width + 200
    Ch_Name.Text = ""
    Ch_Name.Height = 315

    Set Ch_Type = frmCharacteristics.Controls.Add("VB.ComboBox", "Ch_Type" & (Module1.SR_NO), tabDisplay)
    Ch_Type.Visible = True
    Ch_Type.Top = Module1.Top_Position + 100
    Ch_Type.Width = 1500
    Ch_Type.Left = Ch_Name.Left + Ch_Name.Width + 50
    Ch_Type.Text = ""
    'Ch_Type.Height = 315
    Ch_Type.AddItem "Service"
    Ch_Type.AddItem "Special"
    Ch_Type.AddItem "Option"

    Module1.Top_Position = Module1.Top_Position + 400
End Sub

Private Sub Form_Load()
    Module1.SR_NO = 0
    Dim Test_Line As Control
    Set Test_Line = frmCharacteristics.Controls.Add("VB.Line", "LINE", frmCharacteristics)
    Test_Line.Visible = True
    Test_Line.X1 = 100
    Test_Line.Y1 = 600
    Test_Line.X2 = frmCharacteristics.Width
    Test_Line.Y2 = 600
    Top_Position = Test_Line.Y1
    frmCharacteristics.Show
    tabDisplay.Width = frmCharacteristics.Width - 1000
    tabDisplay.Height = frmCharacteristics.Height - 1500
    tabDisplay.Left = frmCharacteristics.Left + 200
    Call set_labels
End Sub


Sub set_labels()

    Dim Label_SR_NO As Control
    Dim Label_Name As Control
    Dim Label_Delete_Row As Control
    Dim Label_Type As Control

    Set Label_Delete_Row = frmCharacteristics.Controls.Add("VB.Label", "Label_Delete_Row" & (Module1.SR_NO), tabDisplay)
    Label_Delete_Row.Visible = True
    Label_Delete_Row.Top = Module1.Top_Position + 100
    Label_Delete_Row.Width = 1000
    Label_Delete_Row.Left = 300
    Label_Delete_Row.Caption = "Delete(Y/N)"
    Label_Delete_Row.Height = 315

    Set Label_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Label_SR_NO" & (Module1.SR_NO), tabDisplay)
    Label_SR_NO.Visible = True
    Label_SR_NO.Top = Module1.Top_Position + 100
    Label_SR_NO.Width = 750
    Label_SR_NO.Left = Label_Delete_Row.Left + Label_Delete_Row.Width + 400
    Label_SR_NO.Caption = "SR_NO"
    Label_SR_NO.Height = 315

    Set Label_Name = frmCharacteristics.Controls.Add("VB.Label", "Label_Name" & (Module1.SR_NO), tabDisplay)
    Label_Name.Visible = True
    Label_Name.Top = Module1.Top_Position + 100
    Label_Name.Width = 2000
    Label_Name.Left = Label_SR_NO.Left + Label_SR_NO.Width + 400
    Label_Name.Caption = "Characteristics Name"
    Label_Name.Height = 315

    Set Label_Type = frmCharacteristics.Controls.Add("VB.Label", "Label_Type" & (Module1.SR_NO), tabDisplay)
    Label_Type.Visible = True
    Label_Type.Top = Module1.Top_Position + 100
    Label_Type.Width = 1500
    Label_Type.Left = Label_Name.Left + Label_Name.Width + 50
    Label_Type.Caption = "Charac. Type"
    Label_Type.Height = 315

    Module1.Top_Position = Module1.Top_Position + 400
End Sub

---

这不是OP的要求。他想改变这种行为