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.
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.
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.
26 févr. 2011 à 11:39
Si le texte se termine par un espace, le programme se bloque.
Si le texte se termine par une mettre, elle est doublée.
11 juil. 2006 à 17:42
je l'avais fait dans un pictureBox
le probleme ici est qu'on ne peu pas dessiner (ecrire) dans une frame
11 juil. 2006 à 17:22
tout plein d'erreurs 438, propriété ou méthode non géré par l'objet :(
26 avril 2006 à 08:39
ton label est transparent ?
26 avril 2006 à 00:18
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
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.