Drawtext sur plusieur ligne (Cesure)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Drawtext sur plusieur ligne (Cesure)

Message par Thyphoon »

Salut les enfants !

J'ai toujours autant de mal a trouver du temps pour passer vous voir :? Et pourtant je dois tant a ce forum et aux personnes qui m'ont aidé !
Histoire de partager quelques choses avec vous, voici une petite procédure qui permet de retourner a la ligne automatique lorsqu'une chaine affiché avec drawtext est trop longue. J'ai chercher sur les différents forums sans résultat !
Ce n'est pas parfait, ça peut peut surement être optimisé.
si je trouve le temps je voudrais rajouter la justification du text pour que ça soit plus jolie ... :P

Voilà c'est pas grand chose mais ça peut toujours servir !!

Code : Tout sélectionner

Procedure DrawTextWidthMax(X.l,Y.l,Width.l,Txt.s,ForGroundCol.l=$FFFFFF,BackGroundCol.l=$000000)   
  Box(X,Y,200,200,#Red)
  Repeat
    Quit=0 ; On réinitialise la variable pour quitter la boucle de recherce d'endroit coupable
    l=0
    Old_l=1
    
    Repeat 
      l=l+1 ;On va regarder le caractère suivant

      ;Si on trouve la fin de le la chaine ou un endroit pour couper alors ...
      If Mid(Txt,l,1)=" " Or l=Len(Txt)
        
        Line.s=Mid(txt,1,l);
        ;On verifie si la ligne reste dans la taille admise ou non
        If TextWidth(Line.s)<Width
          Old_l=l
        ;Si la chaine est trop grande on sort de la boucle
        Else
          Quit=1
        EndIf
      EndIf
      
      ;Si on va trop loin on sort aussi de la boucle
      If l>=Len(Txt)
        Quit=1
      EndIf
      
    Until Quit=1
    
    Line.s=Mid(txt,1,Old_l);On récupère la chaine qui loge dans notre taille admise
    DrawText(X,Y,Line.s,ForGroundCol,BackGroundCol) ; On l'affiche
    Y=Y+TextHeight(Line) ; La prochaine ligne a affiché sera en dessous
    Txt=Right(Txt,Len(Txt)-Len(Line)) ; Et je retire ce que j'ai déjà affiché a la chaine de depart... et si il reste quelques chose on recommence
  Until Len(Txt)=0
EndProcedure

If InitSprite() And InitKeyboard() And OpenWindow(0, 0, 0, 800, 600, "Un écran dans une fenêtre...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  OpenWindowedScreen(WindowID(0), 0, 0, 800, 600, 0, 0, 0)



 
  Repeat ; Boucle principal
  
   Repeat ; Boucle des evenements 
      Event = WindowEvent()
      
      Select Event 
        
        Case #PB_Event_CloseWindow
          End 
      EndSelect
    Until Event = 0
  
   ExamineKeyboard()
   ClearScreen(0) ;
   
   StartDrawing(ScreenOutput())
   
   Txt.s="Voici une phrase  tres tres tres longue qu'il me faut afficher a l'ecran, et je voudrais que le retour a la ligne sois automatique"
   DrawTextWidthMax(100,100,200,Txt) 
   
   StopDrawing()

   FlipBuffers() 

  Until KeyboardPushed(#PB_Key_Escape)

EndIf

End
Dernière modification par Thyphoon le mar. 13/oct./2009 17:33, modifié 1 fois.
Anonyme

Re: Drawtext sur plusieur ligne

Message par Anonyme »

Sympathique ! :wink:
Avatar de l’utilisateur
Ar-S
Messages : 9540
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Drawtext sur plusieur ligne

Message par Ar-S »

Merci pour ce coucou des plus intéressant :mrgreen:
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: Drawtext sur plusieur ligne

Message par Thyphoon »

Merci ! Il n'y a rien de tres compliqué ...j'ai quelques idées pour améliorer les performances, et améliorer les règles de césure ... mais ça sera pour un peu plus tard je vous tiendrais au courant ici !! :)
Répondre