JUSTILABEL

'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
 

25 novembre 2005 11:17:21 :

Mise à jour de la source suite à la sympathique remarque de juju62611.