Add an event handler for each control at runtime VB6

I have a VB6 application in which I would like to have consistent behavior among my controls in general. For example, one of the behaviors would be to highlight a text field when it receives focus and removes highlighting when it loses focus. I would like this to happen in every form.

What I'm trying to do is one helper routine that can be invoked by all forms on loading, which will lead to this behavior. This way, I don’t have to manually enter the code for each individual text field to select it.

I tried to get VB6 to attach an event handler to the control at runtime, but it just barks at me. I come from the .Net background, so maybe I'm wrong in VB6. But how can I get this desired behavior without having to manually encode it for each control?

+5
source share
7 answers

You can also “Subclass” TextBox controls usingWithEvents . The advantage here is that you can code selection and de-highlighting in one place without having to go through and replace all existing controls (as Scott suggests).

, Form_Load , "" . , ; , .Controls . Form_Load.

+3

, VB6 , TextBox . COM, , ActiveX .

, , UserControl, , , . , , VB6. , , .

, , , , / . extender / GetFocus WM_GETFOCUS, , . , . , , . ( ).

, , , /, . . , , .

+2

. , , 50 . Tick Me.ActiveControl, , , /. , , .

GotFocus/LostFocus VB6.

+2

, , - UserControl (MyAdvancedTextBox) . . , , :

( ) , .

VB6 , .NET.

+1

Extender :

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

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

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

, , , . !

, , extender, , , , , , , .

, , . , , , extender .

0

. . . , , Combo . . , ...

Adding code for reference: Expectation:
1. I must be able to remove the removal of a row change in the field "" 2. I must be able to commit changes to the field Combo

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

Code in module 1:

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
0
source

All Articles