Add an event handler to each control on a form at

问题:

I have a VB6 application where I'd like to have a consistent behavior among its controls application-wide. One of the behaviors, for example, would be highlighting a text box when it gains focus and removing the highlight when it loses focus. I'd like this to happen on every form.

What I'm trying to do is have one sub procedure that can be called by all forms when they load that will make this behavior happen. That way, I don't have to manually code for each individual text box to make it highlight.

I've tried getting VB6 to attach an event handler to a control at runtime but it just barks at me. I come from a .Net background so maybe I'm approaching it wrong for VB6. But how can I get this desired behavior without having to manually code it for every control?

回答1:

You could also "Subclass" Your TextBox Controls Using WithEvents. The advantage here is that you can code the highlighting and de-highlighting in one place without having to go through and replace all of your existing controls (as Scott suggests).

The downside is that you have to add code to the Form_Load event of all your forms to "register" the controls on that form. However, even this should not be too bad if you want to apply the technique to every control; in that case, you just need to write a function that loops through the .Controls collection of a form and registers each control. Then just call this function in each form's Form_Load event.

回答2:

Check this out:

Control Arrays for Visual Basic 6.0 Users

回答3:

Another way to achieve the behaviour you want is not to handle the textbox events at all. Instead, set up a Timer control with a small tick interval, say 50 milliseconds. In the Tick event, check Me.ActiveControl to see whether the focus has moved, and highlight/dehighlight accordingly. You will need a static variable to remember which control has the focus.

This is a nice easy way to get a universal GotFocus / LostFocus event handler in VB6.

回答4:

Unfortunately VB6 does not support implementation inheritance and you can't inherit TextBox and just modify or add functionality. It does not support COM aggregation too, though I doubt ActiveX controls specification supports it too.

What you are left with is reimplementing a control from scratch or implementing a custom UserControl that contains the original one and forwards every method, property or event. The problem with the latter approach is not that it's lots of pointless code but the performance of VB6's custom user controls. Built-in controls are really fast and you can place hundreds of labels or textboxes before noticing degradation.

What I'm doing in cases like yours is to implement an extender class that holds a reference to the textbox control, subclasses it and/or listens and responds to raised events from the control. The extender class implements the desired/modified behavior on GetFocus event or WM_GETFOCUS, whatever. Next, for each textbox on the form an instance of the extender is initialized with a reference to the control. All the extenders are held in a collection which can be part of a class that extends the form itself. The form extender can wrap the instantiation and initialization of the control extenders (the For Each In Controls part).

I'm doing this constantly, having very rich extenders for every possible control I'm placing on forms that wrap every property/method I'm accessing. I'm listening for events only on the extenders too. The nice part is that when I find a bug in a 3rd party control I can mitigate it very easily in the control extender.

回答5:

The appropriate way to do what you're asking is to define a new UserControl (MyAdvancedTextBox) and code your intended behavior in there. Then replace all of your text boxes with that user control. It's a lot of work, but it's less work than the alternative:

Manually define an event handler in the code-behind for each text box (or text box control array) and have the event handler pass itself to some common module subroutine that executes your common handling logic.

VB6 events are a lot more primitive than .NET.

回答6:

I am with the Extender idea myself thanks to the tip from this site I have come up with my own solution:

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

Module Module1 Defintion:

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 Definition:

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

So in effect for every new form all you have to do is declare a collection and call the initialiser code in the form load event. Simple!

Furthermore if you have further requirements that you need to refer back to you extender class rather than looping thru your collection you may choose to create a Key of say the control's name when adding to the collection however keep in mind if you are using control arrays on your form your form may need to include the Index in the key.

Also note if you declare the same event in your form for your control both your event and the extender event will fire one after the other. I do not know of any documentation on this however, from my experimentation the extender event goes last.

回答7:

The tips are good. However, the example shared is very limited. I have an issue with the events for dynamic controls. i have to create check box , text box , radio buttons and Combo box on click of a button. I am able to successfully create the dynamic controls. BUT i am not able to capture the actions of each of this control, such change status of check box or radio options or changes in Dropdown text...

Adding the code for reference: Expectation:
1. I should be able to capture delete Row change in the check box
2. I should be able to capture changes in Combo box

Static Controls:
1. Form: frmcharacteristics
2. Button: cmdAddCharacteristics
3. SSTab: tabDisplay

Code in Module1:

Public SR_NO As Long
Public Top_Position As Long

code in 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