vbAccelerator - Contents of code file: Examples_Example1_ctlEnum.ctl

VERSION 5.00
Begin VB.UserControl ctlEnum 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3384
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3840
   ScaleHeight     =   3384
   ScaleWidth      =   3840
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "'TestEnum2' uses the custom implementation of
       IPerPropertyBrowsing."
      Height          =   384
      Left            =   180
      TabIndex        =   3
      Top             =   2556
      Width           =   3408
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "'TestEnum1' uses the standard VB implementation of
       IPerPropertyBrowsing."
      Height          =   384
      Left            =   180
      TabIndex        =   2
      Top             =   1968
      Width           =   3396
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Select this control and then look at the 'TestEnum'
       properties 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         =   $"ctlEnum.ctx":0000
      Height          =   768
      Left            =   180
      TabIndex        =   0
      Top             =   180
      Width           =   3396
      WordWrap        =   -1  'True
   End
End
Attribute VB_Name = "ctlEnum"
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

'public enums
Public Enum TheTestEnum
    tstEnumValue1 = 1
    tstEnumValue2 = 2
    tstEnumValue3 = 3
    
End Enum

'private members
Private m_oPerProp As New CPerPropertyBrowsing
Private m_DispID_TestEnum2 As Long

'persistent property members
Private m_TestEnum1 As TheTestEnum
Private m_TestEnum2 As TheTestEnum

Public Property Get TestEnum1() As TheTestEnum
'return member m_TestEnum1

    TestEnum1 = m_TestEnum1
End Property
Public Property Get TestEnum2() As TheTestEnum
'return member m_TestEnum2

    TestEnum2 = m_TestEnum2
End Property
Public Property Let TestEnum1(ByVal NewVal As TheTestEnum)
'set member m_TestEnum1

    m_TestEnum1 = NewVal
    PropertyChanged "TestEnum1"
End Property
Public Property Let TestEnum2(ByVal NewVal As TheTestEnum)
'set member m_TestEnum2

    m_TestEnum2 = NewVal
    PropertyChanged "TestEnum2"
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 'TestEnum2'
    If DispID = m_DispID_TestEnum2 Then
        'convert current property value to friendlier string
        If m_TestEnum2 = tstEnumValue1 Then
            DisplayName = "One"
        
        ElseIf m_TestEnum2 = tstEnumValue2 Then
            DisplayName = "Two"
        
        Else
            DisplayName = "Three"
        
        End If
        
        '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)

    'if DispID is for property 'TestEnum2'
    If DispID = m_DispID_TestEnum2 Then
        'resize arrays
        ReDim StringsOut(3) As String
        ReDim CookiesOut(3) As Long
        
        'put friendlier names & values into arrays
        StringsOut(0) = "Value 1"
        CookiesOut(0) = tstEnumValue1
        StringsOut(1) = "Value 2"
        CookiesOut(1) = tstEnumValue2
        StringsOut(2) = "Value 3"
        CookiesOut(2) = tstEnumValue3

        '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
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 'TestEnum2'
    If DispID = m_DispID_TestEnum2 Then
        'we stored the actual value of the enum
        'in the cookies array during the call to
        'GetPredefinedStrings', so we can just return the
        'value in 'Cookie'
        Value = Cookie

        '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_TestEnum2 = m_oPerProp.GetDispID("TestEnum2")
End Sub
Private Sub UserControl_InitProperties()

    'initialise default property values
    m_TestEnum1 = tstEnumValue1
    m_TestEnum2 = tstEnumValue1
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    'read properties from stash
    With PropBag
        m_TestEnum1 = .ReadProperty("TestEnum1", tstEnumValue1)
        m_TestEnum2 = .ReadProperty("TestEnum2", tstEnumValue1)
        
    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 "TestEnum1", m_TestEnum1, tstEnumValue1
        .WriteProperty "TestEnum2", m_TestEnum2, tstEnumValue1
        
    End With
End Sub