vbAccelerator - Contents of code file: Examples_Example2_ctlEnumControls.ctl

VERSION 5.00
Begin VB.UserControl ctlEnumControls 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3384
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3840
   ScaleHeight     =   3384
   ScaleWidth      =   3840
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   $"ctlEnumControls.ctx":0000
      Height          =   768
      Left            =   168
      TabIndex        =   2
      Top             =   1992
      Width           =   3444
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Select this control and then look at the
       'ControlsOnForm' property in the VB properties window."
      Height          =   576
      Left            =   180
      TabIndex        =   1
      Top             =   1224
      Width           =   3396
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   $"ctlEnumControls.ctx":00A6
      Height          =   768
      Left            =   180
      TabIndex        =   0
      Top             =   180
      Width           =   3396
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "ctlEnumControls"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'implement 'VB friendly' version of the IPerPropertyBrowsing interface
Implements IPerPropertyBrowsingVB

'private members
Private m_oPerProp As New CPerPropertyBrowsing
Private m_DispID_ControlsOnForm As Long
Private m_strControlsArray() As String

'persistent property members
Private m_strControlsOnForm As String

Public Property Get ControlsOnForm() As String
'return member m_strControlsOnForm

    ControlsOnForm = m_strControlsOnForm
End Property
Public Property Let ControlsOnForm(ByVal NewVal As String)
'set member m_strControlsOnForm

    m_strControlsOnForm = NewVal
    PropertyChanged "ControlsOnForm"
End Property
Private Function IPerPropertyBrowsingVB_GetDisplayString(DispID As Long,
 DisplayName As String) As Boolean
'return a more friendly string than the the default enum variable name
'remember we aren't limited to variable names here, so we can
'use any normally invalid characters, such as spaces and semicolons.
'(returning False let's the caller, ie.VB, do it's default implementation)

    'if DispID is for property 'ControlsOnForm'
    If DispID = m_DispID_ControlsOnForm Then
        'in this instance we are want to return the proper value
        'of the property so we can just return it
        DisplayName = m_strControlsOnForm
        
        'return True to override the default implementation
        IPerPropertyBrowsingVB_GetDisplayString = True
        
    End If
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedStrings(DispID As Long,
 StringsOut() As String, CookiesOut() As Long) As Boolean
'returns an array of strings to represent the property
'names of the specified DispID
'(returning False let's the caller, ie.VB, do it's default implementation)

    Dim oControl As Object
    Dim lngUbound As Long
    
    'if DispID is for property 'ControlsOnForm'
    If DispID = m_DispID_ControlsOnForm Then
        'copy the names of all command button controls on this form into the
         array
        On Error GoTo CATCH_EXCEPTION
        For Each oControl In UserControl.Parent.Controls
            'NOTE:to change this list to display all the controls
            'dropped by a user on a container control, just change
            'the UserControl.Parent.Controls to UserControl.ContainedControls
            If TypeOf oControl Is CommandButton Then
                lngUbound = UBound(StringsOut)
                ReDim Preserve StringsOut(lngUbound + 1) As String
                ReDim Preserve CookiesOut(lngUbound + 1) As Long
                StringsOut(lngUbound) = oControl.Name
                CookiesOut(lngUbound) = lngUbound
                
            End If
            
        Next oControl
        On Error GoTo 0
        'cache the array of control names so we can find them later
        ReDim m_strControlsArray(UBound(StringsOut))
        For lngUbound = 0 To UBound(StringsOut)
            m_strControlsArray(lngUbound) = StringsOut(lngUbound)
            
        Next lngUbound
        
        'NOTE: The CookiesOut array can contain any value. It is
        'used to store numerical data alongside the string representation
        'of the property. It is similar to the relationship between the
        'ItemData and ListItem properties of a ListBox or ComboBox.

        'return True to override the default implementation
        IPerPropertyBrowsingVB_GetPredefinedStrings = True
        
    End If
    Exit Function
    
CATCH_EXCEPTION:
    'The 'Parent' property of the usercontrol is an Extender property,
    'and as such may not be implemented by the controls container
    '(although it is by VB), and so we need to allow for that.
    'Under these circumstances it is safest to allow the container to
    'do it's own default implementation of this routine.
    IPerPropertyBrowsingVB_GetPredefinedStrings = False
    
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedValue(DispID As Long,
 Cookie As Long, Value As Variant) As Boolean
'convert the value we passed previously in 'GetPredefinedStrings' to
'the actual property value.
'(returning False let's the caller, ie.VB, do it's default implementation)

    'if DispID is for property 'ControlsOnForm'
    If DispID = m_DispID_ControlsOnForm Then
        'use the cookie to find the array item we need
        '(we stored the array indexes during the call to GetPredefinedStrings)
        If Cookie < UBound(m_strControlsArray) Then
            Value = m_strControlsArray(Cookie)
    
        Else
            Value = ""
            
        End If
    
        'return True to override the default implementation
        IPerPropertyBrowsingVB_GetPredefinedValue = True
        
    End If
End Function
Private Sub UserControl_Initialize()
    
    'attach the new IPerPropertyBrowsing interface to this control
    m_oPerProp.Attach Me
    'cache the despatch identifiers
    m_DispID_ControlsOnForm = m_oPerProp.GetDispID("ControlsOnForm")
    'initialise controls array
    ReDim m_strControlsArray(0) As String
End Sub
Private Sub UserControl_InitProperties()

    'initialise default property values
    m_strControlsOnForm = ""
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    'read properties from stash
    With PropBag
        m_strControlsOnForm = .ReadProperty("ControlsOnForm", "")
        
    End With
End Sub
Private Sub UserControl_Terminate()
    
    'restore the original interface
    m_oPerProp.Detach
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    'write properties to stash
    With PropBag
        .WriteProperty "ControlsOnForm", m_strControlsOnForm, ""
        
    End With
End Sub