texte justifié

Salutatoi Jean-Marc,

Tu as donc déclaré :

Pour ceux que cela intérèsserait, j'ai écrit une petite fonction
qui permet de justifier un texte sur un nombre donné de
caractères. Cela permet une présentation plus jolie des longs
textes.

Merci, ce sera fort utile.

Bon dimanche aussi.
--
Aski

Merci Jean marc pour cette fonction..

une 'petite amélioration' ( ;o)) à prévoir, (mais je ne juge que par
rapport au screenshot) est comme le fait Word, la justification , tient
compte des sauts de lignes.
apparemment, ta fonction enlève ces sauts de ligne..
Mais de toute façon elle très intéressante . merci pour ce travail.

Driss
"Jean-Marc" <NO_SPAM_jean_marc_n2@yahoo.fr> a écrit dans le message de
news:43c0e731$0$29466$ba620e4c@news.skynet.be...

Bonjour à tous,

Pour ceux que cela intérèsserait, j'ai écrit une petite fonction qui
permet de justifier un texte sur un nombre donné de caractères. Cela
permet une présentation plus jolie des longs textes. Peut aussi être
employé pour générer des états de sortie bien formatés. Le code de la
fonction ainsi qu'un programme complet est disponible ici:
http://myjmnhome.dyndns.org/download.htm

Egalement disponible ici avec un screenshot:
http://users.skynet.be/candide/jmn/justify/justify.htm

Bon dimanche!

--
Jean-marc
Tester mon serveur (VB6) => http://myjmnhome.dyndns.org
"There are only 10 kind of people
those who understand binary and those who don't."
mailto: remove '_no_spam_' ; _no_spam_jean_marc_n2@yahoo.fr

Jean Marc,

je me suis permis de rajouter la fonctionalité dont je parlais. en fait je
rajoute une sub intermédiaire

' voici les textes modifiés

j'ai rajouté un chekbox 'chk_ENTER pour tester les deux possibilités


'-----------------------------------------------------------------------
' Procedure : Command1_Click
' DateTime : 07/10/2004 11:28
' Author : Jean-Marc
' Purpose : main function, transform text in Text1 in justfied text
' and put to Text2
'-----------------------------------------------------------------------
'
Private Sub Command1_Click()
Dim jusText As String
Dim r As Boolean
' *******modification ici
CréeJustifié Text1.Text, jusText, Val(Text3.Text), Chk_ENTER.Value vbChecked ' justify(Text1.Text, jusText, Val(Text3.Text), True)
Text2.Text = jusText

End Sub

'-----------------------------------------------------------------------
' Procedure : justify
' DateTime : 07/10/2004 11:28
' Author : Jean-Marc
' Purpose : justify the text in szIn into the justified version and
' assign to szOut - Width is given by lSize
'-----------------------------------------------------------------------
'
Private Function justify(ByVal szIn As String, _
ByVal lSize As Long) As String
Dim s() As String ' split the entire text in words
Dim I As Long
Dim tmp As String
Dim tmp2 As String
Dim t As String
Dim nbspace As Long
Dim p As Long
Dim start As Long
Dim l As Long
Const MINI_SIZE As Long = 10
Dim Liste As Variant

' "normalize" string, replace crlf by spaces, and 2 spaces by
' single space
t = Replace(szIn, vbCrLf, " ")

' loop to replace muli occurences of spaces by single space
l = Len(t)
t = Replace(t, " ", " ")
While Len(t) <> l
l = Len(t)
t = Replace(t, " ", " ")
Wend

' then TRIM and split in words
t = Trim$(t)
s = Split(t, " ")

For I = LBound(s) To UBound(s)
If Len(s(I)) + 1 >= lSize Then
lSize = Len(s(I)) + 2
End If
Next I

I = LBound(s)
' principle: use the words to build line, until size_max is reached
While I <= UBound(s) ' main loop here
Do While Len(tmp & " " & s(I)) < lSize
If tmp <> "" Then
tmp = tmp & " " & s(I) ' concat with space and token
Else
tmp = s(I) ' simple concat with new token
End If
I = I + 1
If I > UBound(s) Then
Exit Do
End If
Loop
' ajust tmp size to size_MAX
' if the size is reasonnably close to the max (4/5),
' ajust with blanks
If Len(tmp) > (lSize * LIMIT_TO_WRAP) Then
nbspace = lSize - Len(tmp)
start = 1
While nbspace <> 0
p = InStr(start, tmp, " ")
If p Then
tmp = Mid$(tmp, 1, p) & " " & Mid$(tmp, p + 1)
start = p + 2
nbspace = nbspace - 1
Else
If start = 1 Then
nbspace = 0
Else
start = 1
End If
End If
Wend
End If
tmp2 = tmp2 & tmp & vbCrLf
tmp = ""
Wend
'szOut = tmp2 ' assign final value
justify = tmp2
End Function


Private Sub CréeJustifié(Chaine As String, NouvChaine As String, Taille As
Long, ConserveENTER As Boolean)
Dim Liste As Variant
Dim I As Long

NouvChaine = vbNullString

If ConserveENTER = True Then
' on sépare les paragraphes
Liste = Split(Chaine, vbCrLf)
' on regarde si il y a plusieurs lignes
If Liste(0) <> Chaine Then
For I = 0 To UBound(Liste)
'If I <> 0 Then
' NouvChaine = NouvChaine & vbCrLf
'End If
NouvChaine = NouvChaine & justify(Liste(I), Taille)
Next
Else
NouvChaine = justify(Chaine, Taille)
End If
Else
NouvChaine = justify(Chaine, Taille)
End If


End Sub

' ********************************************

"Driss HANIB" <dhanib@club-internet.fr> wrote in message
news:#FjtO0QFGHA.984@tk2msftngp13.phx.gbl...

Jean Marc,

je me suis permis de rajouter la fonctionalité dont je parlais. en fait je
rajoute une sub intermédiaire

' voici les textes modifiés

<snip code>

Hello,

Merci pour cela, c'est une bonne idée et je vais l'ajouter.

--
Jean-marc