[myc] - simulation de la propriété wordwrap d'un label

Description

Cette petite fonction permet de simuler la propriété "WordWrap" d'un label pour qu'on puisse l'appliquer à une form, une pictureBox ou un userControl.

La propriété WordWrap d'un label détermine si celui-ci s'étend verticalement ou horizontalement en fonction du texte spécifié dans sa propriété Caption.

Autrement dit, elle va permettre de couper une chaîne en plusieurs petites chaînes en fonction de la largeur du contrôle cible. Permettant ensuite de les afficher l'une en dessous de l'autre.

J'ai été amené à créer cette fonction car j'en avais besoin dans la réalisation d'un contrôle personnalisé.

J'espère qu'elle pourra aider qqun d'autre aussi !

-MyC-

Source / Exemple :


' ------------------------------------------
'  Auteur : MyCorporation - LAURENT Yannick
' ------------------------------------------

Rem : Cette petite fonction permet de simuler la propriété WordWrap d'un label.

Rem : La propriété WordWrap d'un label détermine si celui-ci s'étend
Rem   verticalement ou horizontalement en fonction du texte spécifié dans
Rem   sa propriété Caption.

Option Explicit

Private Sub Form_Load()

pictureCible.Width = labelSource.Width
pictureCible.Height = labelSource.Height

End Sub

Private Sub commandCopier_Click()

Rem : Explication -> WordWrap(texte source, taille maximale à ne pas dépasser)

pictureCible.Print WordWrap(labelSource.Caption, pictureCible.ScaleWidth)

End Sub

Private Function WordWrap(strTexteSource As String, lngTailleMax As Long) As String
Dim strChaîneCourante As String
Dim strChaîneCoupée As String
Dim strChaîneFormatée As String
Dim intSpacePos As Integer

' Si la largeur du texte source est > que la largeur maximale donnée alors...
If TextWidth(strTexteSource) > lngTailleMax Then
    
    ' Copie le texte source.
    strChaîneCourante = strTexteSource
    
    ' Tant que la largeur de la chaîne en cours de traitement est > que la taille maximale, on éffectue :
    Do While TextWidth(strChaîneCourante) > lngTailleMax
        ' Tant que la largeur de la chaîne en cours de traitement est > que la taille maximale, on éffectue :
        Do While TextWidth(strChaîneCourante) > lngTailleMax
           ' Retient la position du premier espace trouvé dans la chaîne
            ' en cours, en partant de la fin de la chaîne.
            intSpacePos = InStrRev(strChaîneCourante, " ", -1)
            ' S'il n'y a plus d'espace, alors...
            If intSpacePos = 0 Then
                ' On sort de la boucle.
                Exit Do
            Else
                ' Ajoute le morceau de chaîne situé juste après l'espace (au début de la variable).
                strChaîneCoupée = Mid(strChaîneCourante, intSpacePos, Len(strChaîneCourante)) & strChaîneCoupée
                ' Supprime le morceau de chaîne situé après l'espace.
                strChaîneCourante = Mid(strChaîneCourante, 1, intSpacePos - 1)
            End If
        Loop
               
        ' Ajoute la chaîne en cours en lui enlevant le(s) éventuel(s) espace(s) de gauche et en la faisant précéder d'un retour chariot et d'un saut de ligne (à la fin de la variable).
        strChaîneFormatée = IIf(strChaîneFormatée = "", strChaîneCourante, strChaîneFormatée & vbCrLf & LTrim(strChaîneCourante))
        ' La chaîne tronquée à laquelle on enlève le(s) éventuel(s) espace(s) de gauche et de droite devient la chaîne en cours.
        strChaîneCourante = Trim(strChaîneCoupée)
        ' On réinitialise la variable.
        strChaîneCoupée = ""
    Loop
    
    ' Ajoute la dernière chaîne en cours en lui enlevant le(s) éventuel(s) espace(s)
    ' de gauche et en la faisant précéder d'un retour chariot et d'un saut de ligne (à la fin de la variable).
    strChaîneFormatée = strChaîneFormatée & vbCrLf & LTrim(strChaîneCourante)
    
    ' Retourne la chaîne source formatée.
    WordWrap = strChaîneFormatée

Else
    ' Retourne la chaîne source telle quelle.
    WordWrap = strTexteSource
End If

End Function

Conclusion :


Si vous connaissez une façon plus courte et/ou plus rapide donnant le même résultat (avec des API par exemple), merci de m'en faire part !

Codes Sources

A voir également

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.