Clonage de composants.......

Télécharger le projet
Commenter

Description

ca a du arriver a beaucoup d'avoir un ensemble de composants (e.g. un textbox avec un bouton......) , qui doivent etre repliqués n fois. C'est gelère de le faire a lamain , et on est embete avec l'ascenseur !!!!!

Il s'agit d'un controle qui permet de cloner un ensemble de controle (en fait un container et ses objets 'fils') n fois , avec un ascenseur en prime !!

Source / Exemple : 


Private Objects() As Object
Dim ObjHeight As Integer

Private Max As Long

Public Sub UnloadObj(Obj As Object, Index As Integer, ContainedObjects As Variant)
    ' Pour decharger un objet , il faut d'abord decharger tous les objets 'fils'
    Dim nObj As Object
    Dim MaxIndex As Integer
    
    With UserControl
        For a = LBound(ContainedObjects) To UBound(ContainedObjects) 'parcours le tableau d'objets
            Set nObj = ContainedObjects(a) ' regardes l'objet 'a' du tableau (command1 , text2.....)
            Unload nObj(Index) ' supprime l'element 'a' d'indice Index (command1(2) ou text2(2)...)
        Next a
        Unload Obj(Index) 'un fois sans objets fils , le controle est decharge...
        MaxIndex = UBound(Objects)
        For a = Index + 1 To MaxIndex   'decale tous les elements
            Set Objects(a - 1) = Objects(a)
        Next a
        Set Objects(UBound(Objects)) = Nothing  'supprime le dernier , pour pas qu'il soit en double !!!
        ReDim Preserve Objects(MaxIndex - 1)      'redimensionne le tableau en consequence...
        
        Max = Max - ObjHeight                   ' mets a jour l'affichage en
        VS_Change
    End With
End Sub

Public Sub Init(Obj As Object, Count As Integer, Optional IsAContainer As Boolean = False, Optional ContainedObjects As Variant)
    Dim nObj As Object
    With UserControl
        .BackColor = vbWhite
        Obj(0).Move 0, 0, .ScaleX(.ScaleWidth - VS.Width, vbPixels, vbTwips)
        nHeight = Obj(0).Height
        ReDim Preserve Objects(0)
        Set Objects(0) = Obj(0) 'stocke le controle 0
        For a = 1 To Count - 1  'on commence à 1 car le 0 existe deja normallement !!!
            Load Obj(a)
            Obj(a).Visible = True
            Obj(a).Move 0, (a) * nHeight, .ScaleX(.ScaleWidth - VS.Width, vbPixels, vbTwips), nHeight
            
            ReDim Preserve Objects(a)   'agrandit le table interne qui stocke les controles clonés (pour le deplacement...)
            Set Objects(a) = Obj(a)
            
            If IsAContainer Then    ' Si objets contenus...
                For b = LBound(ContainedObjects) To UBound(ContainedObjects) 'parcours du tableau de controles fourni
                    Set nObj = ContainedObjects(b)  'Variable tempo pour ne pas acceder sans arret au tab (là , type Object)
                    If Not nObj Is Nothing Then 'evite certains plantage si un case du tab de controles est vide...
                        Load nObj(a)    'charge un nouvel Objet
                        Set nObj(a).Container = Obj(a)  ' Colle l'objet dans le container aproprié
                        nObj(a).Visible = True  'un objets que l'on vient de charger est invisible...
                    End If
                Next b
            End If
            
        Next a
        ObjHeight = .ScaleY(nHeight, vbTwips, vbPixels) 'taille en pixels de un container
        ' la manip avec les echelles vient du fait que cela doit etre independant de l'echelle selectionnee pour le parent de ReySection....
        Max = Count * ObjHeight - .ScaleHeight 'hauteur totale de la 'pile' de composants
        If Count * ObjHeight > .ScaleHeight Then VS.Enabled = True  'active l'ascenseur si il y a besoin
    End With
End Sub

Private Sub UserControl_Resize()
    VS.Move UserControl.ScaleWidth - VS.Width, 0, VS.Width, UserControl.ScaleHeight
End Sub

Private Sub VS_Change()
    mValue = VS.Value * Max / 100 'pourcentage de la taille totale : evite un depassement de capacite de VS.Max et permet d'avoir un ascenseur a taille constante...
    Dim Obj As Object
    For a = 0 To UBound(Objects)
        Set Obj = Objects(a)
        Obj.Move 0, UserControl.ScaleY(ObjHeight * a - mValue, vbPixels, vbTwips) 'on decale tout et on recommence.....
    Next a
    On Error Resume Next        'un erreur se produit si la feuille n'est pas encore visible, on ne peux pas attribuer le focus...
    UserControl.SetFocus ' evite le clignotement du scrollbar
End Sub

Conclusion :


Voila , vous avez deux exemples à votre dispositions....

Seule chose : tous es composants que vous souhaitez cloner doivent faire partie d'un groupe de contrôles !!!!!
Command1(0) mais pas de (1) (2).........

mis a jour en suivant les conseils de DarkSidious quant aux commentaires.....
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Renfield)