- '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
-
'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