Pass a control array to a class, with events

Hi everyone,

Two forms in a VB6 project my company uses are very much alike, and therefore a class exists with centralized code that serves both forms.
I have to remove a TabStrip control from both forms, and replace it with a series of PictureBoxes next to each other. Each PictureBox represents a tab: it must be colored differently when a user clicks it, a box should be drawn on it when it gets the focus, et cetera. The PictureBoxes are in a control array.
The original code had the TabStrip passed to the class, declared as

Code:

---

Private WithEvents obmdTab As TabStrip

---

, and the class handled

Code:

---

Private Sub obmdTab_Click()

---

.
Instead, I now have to declare something like

Code:

---

Private WithEvents obmdPic As "PictureBox-controlarray"

---

, and the class should handle

Code:

---

Private Sub obmdPic_Click()

---

, which, among other things, should take care of recoloring the PictureBoxes. The Index of the clicked PictureBox obviously should therefore be known to the class as well.

How can I get this all working? What code should replace

Code:

---

Private WithEvents obmdPic() As "PictureBox-controlarray"

---

and how do I get

Code:

---

Private Sub obmdPic_Click()

---

- if that is the right signature - firing at the right time?

Thanks!
Cooz

I think there was a TLB (type library) solution to a similar problem, posted a few weeks ago. You'll need to search for it or someone may be kind enough to reference herein if they recall it.

In the FAQs section of the forum (linked in my signature below), is an article describing this problem and offers non-TLB solutions. Here is the link to that article.

Hi Cooz,

If you're willing to stand your ideas on their head, here's a way to create control arrays from control-non-arrays. I did it to get quasi-control-arrays in the VBA. We all know that it's relatively easy to get WithEvents on a control that's not in an array. Therefore, if you're willing to follow the naming scheme outlined therein, you could get the combination of WithEvents with quasi-control-arrays.

And here's the work by The Trick that I think LaVolpe is referring to. If I remember correctly, with some TypeLib work, The Trick managed to actually "catch" events in a class for a control array.

Good Luck,
Elroy

It all sounds very inside-out to me.

Why not rewrite this mess? Create a UserControl that contains your PictureBoxes and the logic from your blind class. That's the main reason we have UserControls: to create classes that can "see."

Hi LaVolpe, Elroy and dilettante,

Thank you for contributing! I guess I'll stick with creating a new UserControl, as dilettante suggested - and which in fact had crossed my mind before I started this thread. I wondered if there was a simpler way of going about this: something that VB6 already provided and of which I was not aware. I mean both "WithEvents" and control arrays are a VB6 thingy, so why shouldn't their combination be? But no.

It looks like the UserControl will be relatively simple, which helped me in deciding. I'll keep the articles that you link to in mind - they certainly may come in handy in situations where creating a new UserControl will turn out to be much more of a fuss.

Thanks once again!
Cooz

Cooz,

Have you developed a UC before? From everything I see, the VB6 UC technology is quite stable. At first, it's a bit daunting to design your first UC. And there is a wizard, but I always just start from scratch these days.

The main thing to get your head around is the new UserControl_ReadProperties and UserControl_WriteProperties events, along with the PropertyChanged statement. You'll see a PropertyBag object passed into the UserControl_ReadProperties and UserControl_WriteProperties events. Think of this PropertyBag as a memory version of the stuff you see in a .FRM file (when pulled up in Notepad) that's not code. It's just the properties you create for your UC, in addition to the ones that are already apart of the controls you've placed on your UC.

Also, when you place other controls on a UC, their properties do not automatically pass through to the UC's set of properties. You must explicitly create properties (with Get/Let/Set property declarations) that you want your UC to have. In many cases, these will be direct pass-throughs of the controls on the UC.

There's also the Event and RaiseEvent statements. Event is used at module level, and it's how you declare the events of your UC that are raised to the form that has the UC. You use RaiseEvent (somewhere in the UC's code) to fire the events in a form. Also, as with properties, these events are often just pass-throughs of the controls on the UC.

Lastly, there's the UserControl_Initialize event within the UC. This is very useful for positioning all the controls on a UC at runtime.

Maybe you already know all this stuff. :) But I've learned to truly enjoy using UCs. There are more advanced topics having to do with them, such as all the stuff under the Ambient and Extender objects, but it's not at all necessary to bother with those to get a tremendous amount of work done.

Good Luck,
Elroy

EDIT1: For grins, I tried to find my simplest UC. It's the combination of a TextBox and a Label. It allows you (during design-time) to specify a series of clickable options that can be placed into the TextBox. I've attached a demo project.

But here's the code portion of the UC:

Code:

---


'
Option Explicit
'
' Properties:
'    UserControl_ReadProperties: reads the properties out of the FRM or EXE file so that the
'      control is initialized with the correct set of properties when the program runs.
'    UserControl_WriteProperties: writes the properties into the FRM file when the FRM file
'      is saved.
'    To have properties actually appear in the property window, you need to have a public
'      Get & Let with the property name.  This will allow changing of the property during
'      development or during runtime.  A call to PropertyChanged must be made in the
'      Let procedure to inform Windows and the property window of the change.
'    Be sure to set the initial properties in the UserControl_Initialize event.  These
'      may be immediately overwritten if they are changed in design mode or runtime.
'    Optionally, these property values can be saved in local code, typically with the
'      m_ prefix.  If this is done, it should be done in the following events:
'      UserControl_Initialize, Property Let [property name], & UserControl_ReadProperties.
'
' Events:
'    There are two pieces to making events appear on the parent form:
'      1) The event must be declared.  To declare an event, simply place the keyword "Event"
'          with the event name in General code with the variables you wish to pass to the
'          parent form.
'      2) The event must be raised.  This is done anywhere in the control's code with the
'          "RaiseEvent" keyword.  The event name and variables to be passed up must be
'          listed.
'
'
Event Change()
'
Dim m_Options_CommaDelim As String
'

Private Sub lbl_Click(Index As Integer)
    txt.Text = Trim$(lbl(Index).Caption)
End Sub

Private Sub txt_Change()
    RaiseEvent Change
End Sub

Private Sub UserControl_Initialize()
    m_Options_CommaDelim = vbNullString
    lbl(0).Visible = False
    Set lbl(0).Font = txt.Parent.Font
    lbl(0).BackColor = &H8000000F
    lbl(0).ForeColor = &H80000008
    '
    txt.Alignment = 0& ' left justify.
    txt.BackColor = &H80000005
    txt.Borderstyle = 0& ' flat.
    txt.Enabled = True
    Set txt.Font = txt.Parent.Font
    txt.ForeColor = &H80000008
    txt.Locked = False
    txt.Maxlength = 0 ' infinity.
    txt.Text = vbNullString
    '
    PositionControls
End Sub

Public Property Get hWnd() As Long
    ' This is a runtime read-only property that does not appear in the property list.
    hWnd = txt.hWnd
End Property

Public Property Get Options_CommaDelim() As String
    Options_CommaDelim = m_Options_CommaDelim
End Property

Public Property Let Options_CommaDelim(New_Options_CommaDelim As String)
    CreateNewOptions New_Options_CommaDelim
    PropertyChanged "Options_CommaDelim"
End Property

Public Property Get OptionsBackColor() As OLE_COLOR
    OptionsBackColor = lbl(0).BackColor
End Property

Public Property Let OptionsBackColor(ByVal New_OptionsBackColor As OLE_COLOR)
    SetOptionsBackColor New_OptionsBackColor
    PropertyChanged "OptionsBackColor"
End Property

Public Property Get OptionsFont() As StdFont
    Set OptionsFont = lbl(0).Font
End Property

Public Property Set OptionsFont(New_OptionsFont As StdFont)
    SetOptionsFont New_OptionsFont
    PropertyChanged "OptionsFont"
End Property

Public Property Get OptionsFontColor() As OLE_COLOR
    OptionsFontColor = lbl(0).ForeColor
End Property

Public Property Let OptionsFontColor(ByVal New_OptionsFontColor As OLE_COLOR)
    SetOptionsFontColor New_OptionsFontColor
    PropertyChanged "OptionsFontColor"
End Property

Public Property Get Alignment() As AlignmentConstants
    Alignment = txt.Alignment
End Property

Public Property Let Alignment(ByVal New_Alignment As AlignmentConstants)
    txt.Alignment = New_Alignment
    PropertyChanged "Alignment"
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = txt.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    txt.BackColor = New_BackColor
    PropertyChanged "BackColor"
End Property

Public Property Get Borderstyle() As Integer
    Borderstyle = txt.Borderstyle
End Property

Public Property Let Borderstyle(ByVal New_Borderstyle As Integer)
    txt.Borderstyle = New_Borderstyle
    PropertyChanged "Borderstyle"
End Property

Public Property Get Enabled() As Boolean
    Enabled = txt.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    txt.Enabled = New_Enabled
    PropertyChanged "Enabled"
End Property

Public Property Get Font() As StdFont
    Set Font = txt.Font
End Property

Public Property Set Font(ByVal New_Font As StdFont)
    Set txt.Font = New_Font
    PropertyChanged "Font"
End Property

Public Property Get FontColor() As OLE_COLOR
    FontColor = txt.ForeColor
End Property

Public Property Let FontColor(ByVal New_FontColor As OLE_COLOR)
    txt.ForeColor = New_FontColor
    PropertyChanged "FontColor"
End Property

Public Property Get Locked() As Boolean
    Locked = txt.Locked
End Property

Public Property Let Locked(ByVal New_Locked As Boolean)
    txt.Locked = New_Locked
    PropertyChanged "Locked"
End Property

Public Property Get Maxlength() As Long
    Maxlength = txt.Maxlength
End Property

Public Property Let Maxlength(ByVal New_Maxlength As Long)
    txt.Maxlength = New_Maxlength
    PropertyChanged "Maxlength"
End Property

Public Property Get Text() As String
    Text = txt.Text
End Property

Public Property Let Text(ByVal New_Text As String)
    txt.Text = New_Text
    PropertyChanged "Text"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    CreateNewOptions PropBag.ReadProperty("Options_CommaDelim", vbNullString)
    SetOptionsBackColor PropBag.ReadProperty("OptionsBackColor", &H8000000F)
    SetOptionsFont PropBag.ReadProperty("OptionsFont", txt.Parent.Font)
    SetOptionsFontColor PropBag.ReadProperty("OptionsFontColor", &H80000008)
    '
    txt.Alignment = PropBag.ReadProperty("Alignment", 0&)
    txt.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    txt.Borderstyle = PropBag.ReadProperty("Borderstyle", 0&)
    txt.Enabled = PropBag.ReadProperty("Enabled", True)
    Set txt.Font = PropBag.ReadProperty("Font", txt.Parent.Font)
    txt.ForeColor = PropBag.ReadProperty("FontColor", &H80000008)
    txt.Locked = PropBag.ReadProperty("Locked", True)
    txt.Maxlength = PropBag.ReadProperty("Maxlength", 0)
    txt.Text = PropBag.ReadProperty("Text", vbNullString)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "Options_CommaDelim", m_Options_CommaDelim
    PropBag.WriteProperty "OptionsBackColor", lbl(0).BackColor
    PropBag.WriteProperty "OptionsFont", lbl(0).Font
    PropBag.WriteProperty "OptionsFontColor", lbl(0).ForeColor
    '
    PropBag.WriteProperty "Alignment", txt.Alignment
    PropBag.WriteProperty "BackColor", txt.BackColor
    PropBag.WriteProperty "Borderstyle", txt.Borderstyle
    PropBag.WriteProperty "Enabled", txt.Enabled
    PropBag.WriteProperty "Font", txt.Font
    PropBag.WriteProperty "FontColor", txt.ForeColor
    PropBag.WriteProperty "Locked", txt.Locked
    PropBag.WriteProperty "Maxlength", txt.Maxlength
    PropBag.WriteProperty "Text", txt.Text
End Sub

Private Sub UserControl_Resize()
    PositionControls
End Sub

Private Sub CreateNewOptions(New_Options_CommaDelim As String)
    Dim i As Long
    Dim s() As String
    Dim iBound As Long
    Dim iCount As Long
    Dim s1 As String
    Dim s2 As String
    Dim iPtr As Long
    '
    iBound = 10
    ReDim s(1 To iBound)
    ' Save new string.
    m_Options_CommaDelim = New_Options_CommaDelim
    ' Clear old options.
    Do While lbl.Count > 1
        Unload lbl(lbl.Count - 1)
    Loop
    ' Parse options string.
    s1 = m_Options_CommaDelim
    iCount = 0
    Do
        iPtr = InStr(s1, ",")
        If iPtr = 0 Then
            If Len(s1) > 0 Then
                iCount = iCount + 1
                If iCount > iBound Then iBound = iBound + 10: ReDim Preserve s(1 To iBound)
                s(iCount) = s1
            End If
            Exit Do
        End If
        s2 = Left$(s1, iPtr - 1)
        s1 = mid$(s1, iPtr + 1)
        If Len(s2) > 0 Then
            iCount = iCount + 1
            If iCount > iBound Then iBound = iBound + 10: ReDim Preserve s(1 To iBound)
            s(iCount) = s2
        End If
    Loop
    ' Make labels for new options.
    If iCount = 0 Then
        PositionControls
        Exit Sub
    End If
    '
    For i = 1 To iCount
        Load lbl(i)
        lbl(i).Caption = " " & s$(i)
        lbl(i).Visible = True
        lbl(i).Refresh
    Next i
    PositionControls
End Sub

Private Sub SetOptionsBackColor(New_OptionsBackColor As OLE_COLOR)
    Dim i As Long
    '
    For i = 0 To lbl.Count - 1
        lbl(i).BackColor = New_OptionsBackColor
    Next i
End Sub

Private Sub SetOptionsFont(New_OptionsFont As StdFont)
    Dim i As Long
    '
    For i = 0 To lbl.Count - 1
        Set lbl(i).Font = New_OptionsFont
        lbl(i).Refresh
    Next i
    PositionControls
End Sub

Private Sub SetOptionsFontColor(New_OptionsFontColor As OLE_COLOR)
    Dim i As Long
    '
    For i = 0 To lbl.Count - 1
        lbl(i).ForeColor = New_OptionsFontColor
    Next i
End Sub

Private Sub PositionControls()
    Dim i As Long
    Dim lblWidth As Long
    Dim lblLeft As Long
    Static bRecursion As Boolean
    '
    If bRecursion Then Exit Sub
    bRecursion = True
    txt.Top = 0
    txt.Left = 0
    ' Do height first, it's simplier.
    txt.Height = Height
    Height = txt.Height ' txt may resize to a minimum height, so the control must also.
    For i = 0 To lbl.Count - 1
        lbl(i).Height = Height
    Next i
    ' Now, width.
    If lbl.Count = 1 Then
        txt.Width = Width
        Width = txt.Width ' txt may resize to a minimum width, so the control must also.
    Else
        ' We're going to call 240 the minimum textbox width.
        For i = 1 To lbl.Count - 1
            lblWidth = lblWidth + lbl(i).Width
        Next i
        If Width < (lblWidth + 240) Then Width = lblWidth + 240
        txt.Width = Width - lblWidth
        ' And, now we must position the labels.
        lblLeft = txt.Width
        For i = 1 To lbl.Count - 1
            lbl(i).Top = 0
            lbl(i).Left = lblLeft
            lblLeft = lblLeft + lbl(i).Width
        Next i
    End If
    lbl(0).Top = Height * 2 ' Be sure label index 0 is hidden.
    bRecursion = False
End Sub



---

As you can see, it only creates a single event (the Changed event). However, it does setup a few properties, but not as many as the original TextBox. And just as an FYI, when you create a UC, you will get several properties that are at a higher level than your actual UC, such as its Top and Left on the form on which it's placed. Those properties, you don't have to worry about.

Also, I wrote this UC many years ago, and there are some nice comments about how to set things up at the top.

Again, Good Luck,
Elroy

Hi Elroy,

Yes, I have created UCs before; I am familiar with about everything you mentioned here. Thanks anyway!
I haven't ever used the wizard though; is this the "VB ActiveX Control Interface Wizard" option in the Add User Control dialog? And what does it do? And while I'm at it... what exactly is a "Colorful Control", and what do I get when I choose "Control Events"?

This is all just curiosity - don't bother giving me detailed information (or any at all if you don't want to ;) - it is off topic anyway). I don't think I will need these options anytime soon.

Cooz