un peu comme word.
Cette fonction est assez lente, cependant elle suffit pour un rendu sur image / sprite pour une utilisation plus tard.
si cela vous est utile
:Code : Tout sélectionner
;{ initialisation
w = 800
h = 600
If InitSprite() = 0 Or InitKeyboard() = 0
End
EndIf
;}
;{ PROCEDURE
Structure JustifiedText
text.s
longueur.l
EndStructure
Procedure DrawJustifiedText(x.l, y.l, Text.s, largeur_de_justification.l, FrontColor.l = -1, BackColor.l = -1, coefficient_d_acceptation_de_retour_a_la_ligne.l = 5) ; Dessine un texte sur la surface de dessin, on appliquant une justification, retourne la hauteur du texte justifié
;{ initialisation
; on enlève une erreur possible
If BackColor > -1 And FrontColor = -1 : FrontColor = 0 : EndIf
y1 = y ; nécessaire pour retourner la hauteur de tout le texte écrit
nb_ligne.l = CountString(Text, Chr(13)) + 1 ; nombre de ligne séparée par un chr(13)
NewList mot.JustifiedText()
taille_espace.l = TextWidth(" ")
;}
;{ on itère pour chaque ligne
For a = 1 To nb_ligne
partie$ = StringField(Text, a, Chr(13)) ; stockage de la ligne
h.l = TextHeight(partie$) ; hauteur de la ligne courante
nb_space.l = CountString(partie$, " ") + 1
;{ initialisation de tout les paramètres
ClearList(mot())
largeur.l = 0
largeur_space.l = 0
;}
;{ on itère pour chaque mot
For b = 1 To nb_space
tmp.JustifiedText\text = StringField(partie$, b, " ") ; stockage du mot en cours
tmp\longueur = TextWidth(tmp\text) ; calcul de sa longueur graphique
If ListSize(mot()) = 0 And tmp\longueur > largeur_de_justification
;{ si il n'y a pas de mot en mémoire, et que le mot est trop long, alors on le stock pour le découper plus bas
AddElement(mot())
mot()\text = tmp\text
mot()\longueur = tmp\longueur
;}
ElseIf largeur + taille_espace + tmp\longueur > largeur_de_justification
;{ Si le mot courrant fait que la ligne ne tient plus dans la largeur de justification, alors on ecrit la ligne, et on stocke le mot courant pour la ligne suivante
; définition de la taille des espaces
If ListSize(mot()) > 1
espace.l = (largeur_de_justification - largeur_space) / (ListSize(mot()) - 1)
Else
espace = taille_espace
EndIf
; içi on regarde le rapport de grandissement des nouveaux espaces par rapport aux normaux : en gros, si les espaces sont trop grand, on les remet à leur taille normal
; et la ligne n'est pas justifié (mais sinon c'est moche), on peut régler ça avec le paramètre 'coefficient_d_acceptation_de_retour_a_la_ligne'
If espace / taille_espace > coefficient_d_acceptation_de_retour_a_la_ligne : espace = taille_espace : EndIf
curs = 0
;{ on itère pour chaque mot à écrire
ForEach mot()
; on dessine la même chose, mais comme il faut tenir compte des paramètres optionnels de couleur, c'est la galère !
; j'ai essayé d'émuler ça avec les valeurs par défaut de -1 et des IF partout...
If FrontColor > -1 And BackColor = -1
DrawText(x + curs, y, mot()\text, FrontColor)
ElseIf BackColor > -1
DrawText(x + curs, y, mot()\text, FrontColor, BackColor)
Else
DrawText(x + curs, y, mot()\text)
EndIf
; on avance le curseur
curs = curs + mot()\longueur + espace
;{ dessin du fond, si une couleur d'arrière plan est spécifiée
; (ce qui veux dire que comme je ne peux pas récupérer la couleur spécifiée par BackColor(#), il y aura des trous partout autour du texte si on ne spécifie pas de BackColor)
If BackColor > -1 And ListIndex(mot()) + 1 <> ListSize(mot())
Box(x + curs - espace, y, espace, h, BackColor)
EndIf
;}
Next
;}
;{ initialisation d'une nouvelle ligne
largeur = 0
largeur_space = 0
largeur = tmp\longueur
largeur_space = largeur
ClearList(mot())
AddElement(mot())
mot()\text = tmp\text
mot()\longueur = tmp\longueur
;}
;{ on dessine la fin de ligne, si besoin
If BackColor > -1
Box(x + curs - espace, y, largeur_de_justification - curs + espace, h, BackColor)
EndIf
;}
; incrémentation de l'ordonnée
y = y + h
;}
Else
;{ ajout de mots dans la mémoire, tant qu'ils ne dépassent pas de la justification
If largeur = 0
largeur = tmp\longueur
largeur_space = largeur
Else
largeur = largeur + taille_espace + tmp\longueur
largeur_space = largeur_space + tmp\longueur
EndIf
AddElement(mot())
mot()\text = tmp\text
mot()\longueur = tmp\longueur
;}
EndIf
;{ boucle nécessaire pour s'occuper des mots trop long pour entrer sur une ligne
Repeat
If ListSize(mot()) = 1 And mot()\longueur > largeur_de_justification
; on a donc un seul mot, trop grand pour une ligne
mot$ = ""
mot1$ = mot()\text
;{ on test pour chaque nouvelle lettre du mot si ca rentre dans la ligne
For c = 1 To Len(mot1$)
mot$ = mot$ + Mid(mot1$, c, 1)
If TextWidth(mot$ + "-") > largeur_de_justification
;c - 1
;{ on regarde si c'est la fin du mot, ou si faut mettre un tiret
If c < Len(mot1$)
If FrontColor > -1 And BackColor = -1
DrawText(x, y, Mid(mot1$, 1, c) + "-", FrontColor)
ElseIf BackColor > -1
DrawText(x, y, Mid(mot1$, 1, c) + "-", FrontColor, BackColor)
Else
DrawText(x, y, Mid(mot1$, 1, c) + "-")
EndIf
DeleteElement(mot())
AddElement(mot())
mot()\text = Mid(mot1$, c + 1, Len(mot1$) - c)
mot()\longueur = TextWidth(mot()\text)
largeur = mot()\longueur
largeur_space = mot()\longueur
Else
If FrontColor > -1 And BackColor = -1
DrawText(x, y, Mid(mot1$, 1, c), FrontColor)
ElseIf BackColor > -1
DrawText(x, y, Mid(mot1$, 1, c), FrontColor, BackColor)
Else
DrawText(x, y, Mid(mot1$, 1, c))
EndIf
DeleteElement(mot())
largeur = 0
EndIf
;}
Break
EndIf
Next
;}
; incrémentation de l'ordonnée
y = y + h
EndIf
Until largeur <= largeur_de_justification
;}
Next
;}
;{ on répète le code de tout à l'heure pour traiter les dernières lignes
If ListSize(mot()) > 0
If ListSize(mot()) > 1
espace.l = (largeur_de_justification - largeur_space) / (ListSize(mot()) - 1)
Else
espace = taille_espace
EndIf
If espace / taille_espace > coefficient_d_acceptation_de_retour_a_la_ligne : espace = taille_espace : EndIf
curs = 0
ForEach mot()
If FrontColor > -1 And BackColor = -1
DrawText(x + curs, y, mot()\text, FrontColor)
ElseIf BackColor > -1
DrawText(x + curs, y, mot()\text, FrontColor, BackColor)
Else
DrawText(x + curs, y, mot()\text)
EndIf
curs = curs + mot()\longueur + espace
If BackColor > -1 And ListIndex(mot()) + 1 <> ListSize(mot())
Box(x + curs - espace, y, espace, h, BackColor)
EndIf
Next
If BackColor > -1
Box(x + curs - espace, y, largeur_de_justification - curs + espace, h, BackColor)
EndIf
y = y + h
EndIf
;}
Next
;}
ProcedureReturn y - y1
EndProcedure
;}
;{ lancement de la fenetre et du screen
If OpenWindow(0, 0, 0, w, h, "Test : Texte justifié", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0), 0, 0, w, h, 0, 0, 0)
EndIf
EndIf
text$ = "Les lapins sont présents un peu partout sur la planète et se répartissent en neuf genres, tous classés dans la famille des léporidés, avec leurs proches parents les lièvres. Ce ne sont donc pas des rongeurs mais des lagomorphes, une branche cousine qui comprend les lièvres, les lapins et les pikas." + Chr(13) + "Les « lapins » sont classées dans les genres suivants de la famille des Léporidae : Brachylagus, Bunolagus, Caprolagus, Nesolagus, Oryctolagus (lapin commun), Pentalagus, Poelagus, Pronolagus, Romerolagus ou Sylvilagus." + Chr(13) + "Sept de ces genres ne comprennent qu'une seule espèce, le genre Nesolagus comprend deux espèces, le genre Pronolagus en comprend trois et le genre Sylvilagus ou lapins d'Amérique, comprend quinze espèces, soit au moins 27 espèces différentes de lapins en tout."
;}
;{ boucle principale
Repeat
event = WaitWindowEvent()
ExamineKeyboard()
;{ event clavier
If KeyboardReleased(#PB_Key_Escape) : event = #PB_Event_CloseWindow : EndIf
;}
;{ dessin
If StartDrawing(ScreenOutput())
time = ElapsedMilliseconds()
x = 50 : y = 25 : w = 250 : h = DrawJustifiedText(x, y, text$, w, 0, #White)
; Debug ElapsedMilliseconds() - time
LineXY(x - 2, y - 2, x - 2, y + h + 2, #Red)
LineXY(x + w + 2, y - 2, x + w + 2, y + h + 2, #Red)
LineXY(x - 2, y - 2, x + w + 2, y - 2, #Red)
LineXY(x - 2, y + h + 2, x + w + 2, y + h + 2, #Red)
x = 350 : y = 300 : w = 400 : h = DrawJustifiedText(x, y, text$, w, 0, #White)
LineXY(x - 2, y - 2, x - 2, y + h + 2, #Red)
LineXY(x + w + 2, y - 2, x + w + 2, y + h + 2, #Red)
LineXY(x - 2, y - 2, x + w + 2, y - 2, #Red)
LineXY(x - 2, y + h + 2, x + w + 2, y + h + 2, #Red)
x = 400 : y = 125 : w = 80 : h = DrawJustifiedText(x, y, "Test rapide pour être sûr du bon fonctionnement de la procedure", w, 0, #White, 10)
LineXY(x - 2, y - 2, x - 2, y + h + 2, #Red)
LineXY(x + w + 2, y - 2, x + w + 2, y + h + 2, #Red)
LineXY(x - 2, y - 2, x + w + 2, y - 2, #Red)
LineXY(x - 2, y + h + 2, x + w + 2, y + h + 2, #Red)
StopDrawing()
EndIf
FlipBuffers()
;}
Until event = #PB_Event_CloseWindow
;}
End
)
je me suis dis que normalement ça arrive rarement, et que ça n'allais pas être un soucis majeur.
, si tu supprimes l'attribut "Color" dans la procedure, il utilisera la couleur définie par FrontColor(
Faut poster le bug sur le forum anglais.