Justilabel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 392 fois - Téléchargée 71 fois

Contenu du snippet

Alignement justifié d'un Label.

Source / Exemple :


'Nom: JustiLabel
'Arguments: Etiquette (Label à justifier)
'Description: justifie l'alignement du texte d'un Label.
'Remarque: le Label à justifier ne doit pas se trouver dans un contrôle conteneur.

Option Explicit

Public Sub JustiLabel(Etiquette As Label)
    Dim SaveScale As Integer
    Dim Texte As String
    Dim TStr As String
    Dim Mot As String
    Dim TInt As Integer
    Dim DebMot As Integer
    Dim NbrMots As Integer
    Dim Intervalle As Double
    Dim TotIntervalle As Double
    Dim CptIntervalle As Long
    Dim TBoo As Boolean
    Dim LastLigne As Boolean
    Dim Forme As Object
    Set Forme = Etiquette.Container
    SaveScale = Forme.ScaleMode
    Forme.ScaleMode = 3
    Etiquette.Visible = False
    Forme.CurrentX = Etiquette.Left
    Forme.CurrentY = Etiquette.Top
    Forme.Font = Etiquette.Font
    Forme.FontBold = Etiquette.FontBold
    Forme.FontItalic = Etiquette.FontItalic
    Forme.FontName = Etiquette.FontName
    Forme.FontSize = Etiquette.FontSize
    Forme.FontStrikethru = Etiquette.FontStrikethru
    Forme.FontUnderline = Etiquette.FontUnderline
    Forme.ForeColor = Etiquette.ForeColor
    Texte = Etiquette.Caption
    LastLigne = False
    Do While (Texte <> "")
        TInt = 0
        TStr = ""
        TBoo = False
        Do While (Forme.TextWidth(TStr) < Etiquette.Width)
            TInt = TInt + 1
            If (TStr = Left(Texte, TInt)) Then
                TBoo = True
                LastLigne = True
                Exit Do
            End If
            TStr = Left(Texte, TInt)
        Loop
        TStr = Left(Texte, TInt - 1)
        Do While (TBoo = False)
            If ((Right(TStr, 1) <> " ") And (Right(TStr, 1) <> "-") And (Right(TStr, 1) <> ",") And (Right(TStr, 1) <> ".") And (Right(TStr, 1) <> ";") And (Right(TStr, 1) <> "?") And (Right(TStr, 1) <> "!")) Then
                TInt = TInt - 1
                TStr = Left(Texte, TInt - 1)
            Else
                TBoo = True
            End If
        Loop
        If (Left(TStr, 1) = " ") Then
            TStr = Right(TStr, TInt - 2)
        End If
        NbrMots = 0
        TInt = 0
        Do While (TInt <> Len(TStr))
            DebMot = TInt
            Do While ((TInt <> Len(TStr)) And (Mid(TStr, TInt + 1, 1) <> " "))
                TInt = TInt + 1
            Loop
            If (TInt <> Len(TStr)) Then
                TInt = TInt + 1
            End If
            NbrMots = NbrMots + 1
        Loop
        If (NbrMots > 1) Then
            Intervalle = (Etiquette.Width - (Forme.TextWidth(TStr))) / (NbrMots - 1)
        Else
            Intervalle = 0
        End If
        CptIntervalle = 0
        TotIntervalle = 0
        DebMot = 0
        TInt = 0
        Do While (TInt <> Len(TStr))
            DebMot = TInt
            Do While ((TInt <> Len(TStr)) And (Mid(TStr, TInt + 1, 1) <> " "))
                TInt = TInt + 1
            Loop
            Mot = Mid(TStr, DebMot + 1, TInt - DebMot)
            Forme.Print Mot;
            Forme.Print " ";
            If (LastLigne = False) Then
                TotIntervalle = TotIntervalle + Intervalle
                Forme.CurrentX = Forme.CurrentX + CInt(TotIntervalle - CptIntervalle)
                CptIntervalle = CptIntervalle + CInt(TotIntervalle - CptIntervalle)
            End If
            If (TInt <> Len(TStr)) Then
                TInt = TInt + 1
            End If
        Loop
        Forme.Print
        Texte = Right(Texte, (Len(Texte) - TInt))
        Forme.CurrentX = Etiquette.Left
    Loop
    Forme.ScaleMode = SaveScale
End Sub

Conclusion :


Ce n''est pas grand chose, mais j'ai créé ce module parce que je devais "justifier" l'alignement d'un Label dans un Splash Screen.
Ajouter un commentaire Commentaires
1nonos1
Messages postés
1
Date d'inscription
vendredi 31 octobre 2003
Statut
Membre
Dernière intervention
26 février 2011

26 févr. 2011 à 11:39
Très bon boulot mais il y a un bug si la fin du texte ne se termine pas par un point.
Si le texte se termine par un espace, le programme se bloque.
Si le texte se termine par une mettre, elle est doublée.
juju62611
Messages postés
16
Date d'inscription
dimanche 2 février 2003
Statut
Membre
Dernière intervention
25 novembre 2005

11 juil. 2006 à 17:42
oui effectivement ça ne marche pas dans une frame
je l'avais fait dans un pictureBox

le probleme ici est qu'on ne peu pas dessiner (ecrire) dans une frame
zeOffspring
Messages postés
18
Date d'inscription
jeudi 22 janvier 2004
Statut
Membre
Dernière intervention
17 août 2006

11 juil. 2006 à 17:22
perso j'ai un label dans une frame et ça ne fonctionne pas
tout plein d'erreurs 438, propriété ou méthode non géré par l'objet :(
juju62611
Messages postés
16
Date d'inscription
dimanche 2 février 2003
Statut
Membre
Dernière intervention
25 novembre 2005

26 avril 2006 à 08:39
est tu sur d'avoir autoredrax = true ?

ton label est transparent ?
LAMAN
Messages postés
6
Date d'inscription
lundi 15 novembre 2004
Statut
Membre
Dernière intervention
20 septembre 2006

26 avril 2006 à 00:18
c'est une bonne idéé mais comment utiliser cette procédure dans un code est ce que cette procedure est une fonction ou quoi ?

j'ai copié votre procedure dans un module et j'ai changé le mot sub justilabel par function justilabel et sa n'a pas marché

j'ai creer un form avec un bouton command et un label et j'ai ecris ce code

Private Sub command1_Click()
JustiLabel (Label1)
End Sub

Private Sub Form_Load()
Label1.Caption = "je suis un homme de confiance croyez moi c'est sur je ne ment pas"

End Sub


et merci
Afficher les 6 commentaires

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.