associer un PropertyPage à un module de classeRésolu

Question

Bonjour,
je souhaiterais savoir de quelle manière implémenter/associer une page de propriété pour un module de classe.

ce serrait pour faire comme les OLE_COLOR ou les Font par exemple.
A savoir : j'ai un control activX avec une propriété Toto (implémenté en module de classe possédant lui même pls propriétés) et je souhaiterais que le programmeur puisse avoir dans la boîte de propriétés un petit carré avec 3 petits points (comme pour choisir une couleur/ un font/ une image ...ect).

J'ai essayé avec une propertypage mais je ne suis plus sur du tout que ce soit la bonne manière.
Ce pourrait être avec une form private à l'activX mais dans ce cas je ne sais absolument pas l'evenement auquel lier le FormLoad

voila ^^ encore une question certainement à deux balles mais bon.

Flocreate · Accepted Answer

bon ben finalement j'ai utilisé des propriétés String en parallèle des classes affin d'avoir un truc qui s'affiche dans la "Property Grid"
maintenant ca marche a peut près comme je le souhaitais.
j'utilise deux classes : classe1 et Classe2 juste pour vérifier l'utilisation de "Implements"

voici le code si toute fois des personnes voulaient avoir un exemple
zip à télécharger à l'adresse : http://www.megaupload.com/?d=XMMO1649

Module de Classe : cPPageHook
Option Explicit
Public Function DisplayString() As String
    'Oblige toutes les classes implémentant celle ci à posséder cette property
End Function
Public Sub Start()
    'oblige toute classe implémentant celle ci à avoir cette méthode
End Sub


Module de Classe : Classe1 & Classe2 (exactement le même code)
Option Explicit
    Public Event PropertyChanged(Name As String)
    Private pA As Integer
    Private pB As Integer

'**********************************************************************
    Implements cPPageHook

        Public Function cPPageHook_DisplayString() As String
                cPPageHook_DisplayString = A & " " & B
        End Function
        Public Sub cPPageHook_Start()
            Dim res As String
                res = InputBox("Entréer A et B séparés par des espaces", "class1")
            If (res <> "") Then
                Dim T() As String
                T = Split(res, " ")
                    A = T(0)
                    B = T(1)
            End If
        End Sub
'**********************************************************************

Public Property Get A() As Integer
    A = pA
End Property
Public Property Let A(nwA As Integer)
    pA = nwA
    RaiseEvent PropertyChanged("A")
End Property

Public Property Get B() As Integer
    B = pB
End Property
Public Property Let B(nwB As Integer)
    pB = nwB
    RaiseEvent PropertyChanged("B")
End Property

Private Sub Class_Initialize()
    A = 0
    B = 0
End Sub
Public Property Get Str_Values() As String
    Str_Values = pA & " " & pB
End Property
Public Property Let Str_Values(nw As String)
    Dim T() As String
    T = Split(nw, " ")
On Error Resume Next
    A = T(0)
    B = T(1)
End Property


UserControl : Usercontrol1
Option Explicit
'********************************************************************************************************
'   Pour l'utilisation de pages de propriétés
'********************************************************************************************************
    Implements IPerPropertyBrowsingVB
    Implements IPropertyPageHookClient
        Private m_oCOMSupport As New COMSupport     'L'objet gérant les pages de propriété
        Private m_MappedPropertyDispID As Long      'La variable qui contiendras le N° de la propriété demandée
'********************************************************************************************************

Private WithEvents p_Cls1 As Class1
Private WithEvents p_Cls2 As Class2

'********************************************************************************************************
Private Function IPerPropertyBrowsingVB_GetDisplayString(ByVal DispID As Long, DisplayName As String) As Boolean
'''    IPerPropertyBrowsingVB_GetDisplayString = True
'''    Select Case DispID
'''        Case Is cvbGetDispID(Me, "Def_Couleurs1"): DisplayName p_Cls1.cPPageHook_DisplayString()
'''        Case Is cvbGetDispID(Me, "Def_Couleurs2"): DisplayName p_Cls2.cPPageHook_DisplayString()
'''        Case Else: IPerPropertyBrowsingVB_GetDisplayString = False
'''    End Select
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedStrings(ByVal DispID As Long, ByVal Properties As vbACOM10.PropertyListItems) As Boolean
    'Debug.Assert Not (DispIP_C1 = DispID)
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedValue(ByVal DispID As Long, ByVal Cookie As Long, Value As Variant) As Boolean
    'Debug.Assert Not (DispIP_C1 = DispID)
End Function
Private Function IPerPropertyBrowsingVB_MapPropertyToPage(ByVal DispID As Long, ClassID As String) As Boolean
    IPerPropertyBrowsingVB_MapPropertyToPage = True
    m_MappedPropertyDispID = DispID
    ClassID = "vbACOM10.PropertyPageHook"
    
    Select Case DispID
        Case Is = cvbGetDispID(Me, "Def_Couleurs1"):
        Case Is = cvbGetDispID(Me, "Def_Couleurs2"):
        Case Else: IPerPropertyBrowsingVB_MapPropertyToPage = False
    End Select
End Function
'********************************************************************************************************
Private Function IPropertyPageHookClient_Show(ByVal hWndParent As Long) As Boolean
    IPropertyPageHookClient_Show = True
    Select Case m_MappedPropertyDispID
        Case Is = cvbGetDispID(Me, "Def_Couleurs1"): Call p_Cls1.cPPageHook_Start
        Case Is = cvbGetDispID(Me, "Def_Couleurs2"): Call p_Cls2.cPPageHook_Start
        Case Else: IPropertyPageHookClient_Show = False
    End Select
End Function
'********************************************************************************************************

'########################################################
Public Property Get C1() As Class1
    Set C1 = p_Cls1
End Property
Public Property Set C1(ByVal nwC1 As Class1)
    Set p_Cls1 = nwC1
    PropertyChanged "C1"
End Property
Private Sub p_Cls1_PropertyChanged(Name As String)
    PropertyChanged "C1"
End Sub
'########################################################
'########################################################
Public Property Get C2() As Class2
    Set C2 = p_Cls2
End Property
Public Property Set C2(ByVal nwC2 As Class2)
    Set p_Cls2 = nwC2
    PropertyChanged "C2"
End Property
Private Sub p_Cls2_PropertyChanged(Name As String)
    PropertyChanged "C2"
End Sub
'########################################################


Private Sub UserControl_Initialize()
    '******************************************************
    Call m_oCOMSupport.Attach(Me)
    '******************************************************
End Sub
Private Sub UserControl_Terminate()
    '******************************************************
    m_oCOMSupport.Detach
    '******************************************************
End Sub


Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Set p_Cls1 New Class1: p_Cls1.Str_Values PropBag.ReadProperty("C1", "0 0")
    Set p_Cls2 New Class2: p_Cls2.Str_Values PropBag.ReadProperty("C2", "0 0")
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("C1", p_Cls1.Str_Values, "0 0")
    Call PropBag.WriteProperty("C2", p_Cls2.Str_Values, "0 0")
End Sub

Public Property Get Def_Couleurs1() As String
    Def_Couleurs1 = p_Cls1.Str_Values
End Property
Public Property Let Def_Couleurs1(nw As String)
    p_Cls1.Str_Values = nw
End Property
Public Property Get Def_Couleurs2() As String
    Def_Couleurs2 = p_Cls2.Str_Values
End Property
Public Property Let Def_Couleurs2(nw As String)
    p_Cls2.Str_Values = nw
End Property

Flocreate · Answer

personne ne sait ?
et tant qu'on y est, comment définit-on le text affiché ?
genre pour les propriété stdPicture c'est "(Aucun)" ou "(Picture)"

Flocreate · Answer

peut être du côté d'un "Implement ..." ?

Renfield · Answer

on en a longuement débatu il y a deux semaines, une source a été postée 

Renfield - Admin CodeS-SourceS - MVP Visual Basic

Renfield · Answer

http://www.vbfrance.com/codes/USERCONTROL-AVEC-PROPERTIES-PERSONALISABLE_51159.aspx


Renfield - Admin CodeS-SourceS - MVP Visual Basic

Flocreate · Answer

ca marche impec pour les propriétés de types primitifs (string, integer ...)
mais je n'arrive pas à l'utiliser pour une propriété de type ModuleDeClasse

en effet, dans la boite contenant les propriétés (Nom + Value) les lignes pour les propriétés de types Classe ne sont pas ajoutés.
Y a t il une manip particulière a faire ?
Dans la source dont tu m'a donné l'adresse, il le fait avec la propriété Caption de tipe String... ^^

j'ai fait un petit projet de test que je te soumet :
http://www.megaupload.com/?d=X958PFXB
(en passant j'ai apris a uploader sur megaupload ^^)

cordialement,

Renfield · Answer

ca marche pour tout...
simplement, le String, c'est pour afficher quelque chose dans la property grid.

après, quand on clique sur [...] tu fais ce que tu veux


Renfield - Admin CodeS-SourceS - MVP Visual Basic

Flocreate · Answer

de plus, une chose me choque :

Option Explicit
'********************************************************************************************************
'   Pour l'utilisation de pages de propriétés
'********************************************************************************************************
    Implements IPerPropertyBrowsingVB
    Implements IPropertyPageHookClient
        Private m_oCOMSupport As New COMSupport     'L'objet gérant les pages de propriété
        Private m_MappedPropertyDispID As Long      'La variable qui contiendras le N° de la propriété demandée
'********************************************************************************************************

Private WithEvents pCl As Class1
Private WithEvents pC2 As Class2

'********************************************************************************************************
Private Function IPerPropertyBrowsingVB_GetDisplayString(ByVal DispID As Long, DisplayName As String) As Boolean
    IPerPropertyBrowsingVB_GetDisplayString = True
    Select Case DispID
        Case Is cvbGetDispID(Me, "C1"): DisplayName pC1.cPPageHook_DisplayString()
        Case Is cvbGetDispID(Me, "C2"): DisplayName pC2.cPPageHook_DisplayString()
        Case Else: IPerPropertyBrowsingVB_GetDisplayString = False
    End Select
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedStrings(ByVal DispID As Long, ByVal Properties As vbACOM10.PropertyListItems) As Boolean
    'Debug.Assert Not (DispIP_C1 = DispID)
End Function
Private Function IPerPropertyBrowsingVB_GetPredefinedValue(ByVal DispID As Long, ByVal Cookie As Long, Value As Variant) As Boolean
    'Debug.Assert Not (DispIP_C1 = DispID)
End Function
Private Function IPerPropertyBrowsingVB_MapPropertyToPage(ByVal DispID As Long, ClassID As String) As Boolean
    IPerPropertyBrowsingVB_MapPropertyToPage = True
    Select Case DispID
        Case Is cvbGetDispID(Me, "C1"): ClassID "vbACOM10.PropertyPageHook"
        Case Is cvbGetDispID(Me, "C2"): ClassID "vbACOM10.PropertyPageHook"
        Case Else: IPerPropertyBrowsingVB_MapPropertyToPage = False
    End Select
End Function
'********************************************************************************************************
Private Function IPropertyPageHookClient_Show(ByVal hWndParent As Long) As Boolean
    IPropertyPageHookClient_Show = True
    Select Case hWndParent
        Case Is = cvbGetDispID(Me, "C1"): Call C1.cPPageHook_Start
        Case Is = cvbGetDispID(Me, "C2"): Call C2.cPPageHook_Start
        Case Else: IPropertyPageHookClient_Show = False
    End Select
End Function
'********************************************************************************************************

'########################################################
Public Property Get C1() As Class1
    Set C1 = pC1
End Property
Public Property Let C1(nwC1 As Class1)
    Set pC1 = nwC1
    RaiseEvent PropertyChanged("C1")
End Property
Private Sub pCl_PropertyChanged(Name As String)
    RaiseEvent PropertyChanged("C1")
End Sub
'########################################################
'########################################################
Public Property Get C2() As Class2
    Set C2 = pC2
End Property
Public Property Let C2(nwC2 As Class2)
    Set pC2 = nwC2
    RaiseEvent PropertyChanged("C2")
End Property
Private Sub pC2_PropertyChanged(Name As String)
    RaiseEvent PropertyChanged("C2")
End Sub
'########################################################


Private Sub UserControl_Initialize()
    '******************************************************
    Call m_oCOMSupport.Attach(Me)
    '******************************************************
End Sub
Private Sub UserControl_Terminate()
    '******************************************************
    m_oCOMSupport.Detach
    '******************************************************
End Sub


Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Set C1 = PropBag.ReadProperty("C1", New Class1)
    Set C2 = PropBag.ReadProperty("C2", New Class2)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("C1", C1, New Class1)
    Call PropBag.WriteProperty("C2", C2, New Class2)
End Sub


lorsque j'affiche un composant, il m'affiche le message d'erreur : pC1 non déclaré. VBE a t il besoin de mes lunettes ?

Flocreate · Answer

ca marche pour tout...
simplement, le String, c'est pour afficher quelque chose dans la property grid.

après, quand on clique sur [...] tu fais ce que tu veux 
je souhaite justement que ma propriété de type Class1 apparaisse dans la "Property Grid"

je n'ai peut être pas été très clair (avec moi même surement) sur ce que je cherche a faire.

* J'ai une Classe (module de classe) Class1 qui contient 4 propriétés de type Long
* J'ai un usercontrol UC1 qui contient 2 propriétés de type Class1
* Je souhaite avoir dans la "Property Grid" des lignes Nommées Couleur1 et Couleur2 avec le [...] qui permet de lancer une popup qui permet le choix des couleurs.

Pourquoi s'embêter de la sorte pour 8 malheureux Property Get+Let ?
1> parsque je trouve cela plus propre ainsi
2> parsque je peut être amené à utiliser cela pour un nombre plus ou moins grand de Clss dans d'autreq usercontrols

Pourquoi ne pas utiliser une "fausse propriété String" 
parsque le nom affiché dans la property grid doit être le même que la propriété Get/Let/set utilisable en ligne de code (sinon ca n'as plus de sens a mon gout)

Flocreate · Answer

je n'ais pas dis mais cela va de soit :
>>> UN GRAND MERCI A RENFIELD

Associer un PropertyPage à un module de classe

10 réponses

Votre réponse