在运行时VB6上为表单上的每个控件添加一个事件处理程序

时间：2011-03-25 16:32:50

标签： dynamic vb6 event-handling look-and-feel

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

我正在尝试做的是有一个子程序，当它们加载时可以被所有表单调用，这将使这种行为发生。这样，我就不必为每个单独的文本框手动编码以使其突出显示。

我试过让VB6在运行时将一个事件处理程序附加到一个控件，但它只是咆哮着我。我来自.Net背景，所以也许我接近VB6的错误。但是，如何在不必为每个控件手动编写代码的情况下获得所需的行为？

7 个答案:

答案 0 :(得分：3)

你也可以"Subclass" Your TextBox Controls Using WithEvents。这里的优点是您可以在一个地方编码突出显示和去突出显示，而无需通过并替换所有现有控件（如Scott建议的那样）。

缺点是您必须将代码添加到所有表单的Form_Load事件中以“注册”该表单上的控件。但是，如果您想将该技术应用于每个控件，那么即使这样也不应该太糟糕;在这种情况下，您只需要编写一个循环遍历表单的.Controls集合并注册每个控件的函数。然后在每个表单的Form_Load事件中调用此函数。

答案 1 :(得分：2)

检查出来：

Control Arrays for Visual Basic 6.0 Users

答案 2 :(得分：2)

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

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

我在像你这样的情况下所做的是实现一个扩展器类，它包含对文本框控件的引用，对它进行子类化和/或监听并响应来自控件的引发事件。扩展器类在GetFocus事件或WM_GETFOCUS上实现所需/修改的行为，无论如何。接下来，对于表单上的每个文本框，使用对控件的引用初始化扩展器的实例。所有扩展器都保存在一个集合中，该集合可以是扩展表单本身的类的一部分。表单扩展器可以包装控件扩展器的实例化和初始化（For Each In Controls部分）。

我经常这样做，拥有非常丰富的扩展程序，用于我正在放置的表单上的每个可能的控件，它包含我正在访问的每个属性/方法。我也只是在扩展器上听事件。好的部分是，当我在第三方控件中发现错误时，我可以在控件扩展器中轻松缓解它。

答案 3 :(得分：2)

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

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

答案 4 :(得分：1)

执行所要求的适当方法是定义新的UserControl（MyAdvancedTextBox）并在其中编码您的预期行为。然后用该用户控件替换所有文本框。这是一项很多工作，但它的工作量比替代方案少：

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

VB6事件比.NET更原始。

答案 5 :(得分：0)

我正在使用扩展器的想法，感谢本站点的提示，我提出了自己的解决方案：

Class clsTextBoxExtender Defintion：

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

模块模块1定义：

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

Form Form1定义：

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

因此，对于每个新表单，您只需要声明一个集合并在表单加载事件中调用初始化代码。简单！

此外，如果您有进一步的要求需要返回扩展程序类而不是循环访问您的集合，您可以选择在添加到集合时创建一个说出控件名称的密钥但是请记住如果您正在使用您的表单上的控件数组可能需要在键中包含索引。

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

答案 6 :(得分：0)

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

添加参考代码： 后市展望：
1.我应该能够在复选框中捕获删除行更改 2.我应该能够在组合框中捕获更改

静电控制：
1.形式：frmcharacteristics
2.按钮：cmdAddCharacteristics
3. SSTab：tabDisplay

Module1中的代码：

Public SR_NO As Long
Public Top_Position As Long

frmCharacterisitcs中的代码

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
相关问题
最新问题