PureBasic

Code : Tout sélectionner

Procedure.S autoreturn(t$,lenmax)
sp=0
Repeat
	If Len(t$)>=lenmax
		osp=sp+1
		sp=FindString(t$," ",osp)
		If sp>=osp
			If sp<=lenmax
				cut=sp-1
			Else
				ex=1
			EndIf
		Else
			ex=1
		EndIf
	Else
		cut=Len(t$)
		ex=1
	EndIf
Until ex=1
ProcedureReturn Left(t$,cut)
EndProcedure 
Debug "'"+autoreturn("ceci est un test",5)+"'"
Debug "'"+autoreturn("ceci est un test",50)+"'"
Debug "'"+autoreturn("ceci est un test",12)+"'"

Code : Tout sélectionner

 If Len(t$)>=lenmax 

Code : Tout sélectionner

 If Len(t$)>lenmax 

Code : Tout sélectionner

; Auteur : Le Soldat Inconnu
; Version de PB : 4
;
; Explication du programme :
; 

Procedure.s CreationTexte(Texte.s, Longueur.l, FontID)
  Protected NewList Ligne.s()
  Protected Image.l, Coupe.s, Caractere.s
  ; Pour compliquer, je ne limite pas en caractère mais en pixel
  ; Pour cela, j'utilise TextWidth( donc il faut un drawing
  
  Image = CreateImage(#PB_Any, 10, 10)
  StartDrawing(ImageOutput(Image))
    
    DrawingFont(FontID)
    
    ; On commence la première ligne
    AddElement(Ligne())
    
    For n = 1 To Len(Texte) ; Pour tous les caractères
      Caractere.s = Mid(Texte, n, 1)
      Select Caractere
        Case Chr(13) 
          ; Je fais rien avec ca, un passage de ligne d'un éditeur de texte, c'est chr(13) + chr(10)
        Case Chr(10) ; donc je m'occupe que du chr(10)
          AddElement(Ligne()) ; on passe à la ligne suivante
        Default ; Sinon, pour les autres caractères
          Ligne() + Caractere ; J'ajoute le caractere à la ligne
          If TextWidth(Ligne()) > Longueur ; Si le texte est trop long
            
            For nn = Len(Ligne()) To 1 Step -1 ; On remonte au dernier espace
              Caractere.s = Mid(Ligne(), nn, 1)
              
              If Caractere = " " ; au premier espace
                Coupe.s = Right(Ligne(), Len(Ligne()) - nn)
                Ligne() = Left(Ligne(), nn)
                AddElement(Ligne()) ; on passe à la ligne suivante
                Ligne() = Coupe
                Break
              EndIf
              
              If nn = 1 ; On n'a pas trouvé d'espace, donc le mot est trop long et ne rentre pas dans la ligne, donc on met un tiret
                Caractere = Right(Ligne(), 1) ; on récupère le dernier caractère
                Ligne() = Left(Ligne(), Len(Ligne()) - 1) + "-" ; on le remplace par un -
                AddElement(Ligne()) ; on passe à la ligne suivante
                Ligne() = Caractere
              EndIf
              
            Next
            
          EndIf
          
      EndSelect
    Next
    
  StopDrawing()
  FreeImage(Image)
  
  ; On regroupe le texte
  Texte = ""
  ForEach Ligne()
    If Texte <> ""
      Texte + Chr(10) ; Le séparateur de ligne ici
    EndIf
    Texte + Ligne()
  Next
  
  ProcedureReturn Texte
EndProcedure

;- Début du programme

Restore ExempleDeTexte
For n = 1 To 7
  Read Ligne.s
  Texte.s + Ligne + Chr(10)
Next

;- Police par défaut de windows
FontID = GetStockObject_(#DEFAULT_GUI_FONT)

Texte = CreationTexte(Texte, 200, FontID)

; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 320, 320, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0 Or CreateGadgetList(WindowID(0)) = 0
  End
EndIf

EditorGadget(0, 10, 10, 300, 300) ; une zone de texte

SetGadgetText(0, Texte)

Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_Menu
      Select EventMenu() ; Menus
          
      EndSelect
      
    Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
          
      EndSelect
  EndSelect
  
Until Event = #PB_Event_CloseWindow

End

DataSection
  ExempleDeTexte:
  Data.s "PureBasic est un langage de programmation basé sur les règles du langage BASIC. Ses caractéristiques majeures sont :"
  Data.s ""
  Data.s "- Portabilité: PureBasic fonctionne actuellement pleinement sous Windows, AmigaOS et Linux."
  Data.s "- Rapidité: PureBasic est un véritable compilateur qui produit des exécutables compacts et optimisés."
  Data.s "- Simplicité: PureBasic utilise la syntaxe du langage BASIC, très répandue et simple à apprendre."
  Data.s ""
  Data.s "PureBasic a été conçu aussi bien pour les débutants que pour les programmeurs expérimentés. Nous avons consacré beaucoup de temps et d'efforts pour vous proposer un langage rapide, fiable et convivial. Malgré sa syntaxe de base simple et rapidement assimilable, les possibilités de PureBasic sont infinies, grâce à de nombreuses caractéristiques évoluées comme, entre autres, les pointeurs, structures, procédures, listes dynamiques, etc. Le programmeur expérimenté n'aura aucune difficulté à accéder aux structures du système d'exploitation et aux API's."
EndDataSection

Code : Tout sélectionner

Procedure.S autoreturn(t$,lenmax)
sp=0
Repeat
   If Len(t$)>=lenmax
      osp=sp+1
      sp=FindString(t$," ",osp)
      If sp>=osp
         If sp<=lenmax
            cut=sp-1
         Else
            ex=1
         EndIf
      Else
         ex=1
      EndIf
   Else
      cut=Len(t$)
      ex=1
   EndIf
Until ex=1
ProcedureReturn Left(t$,cut)
EndProcedure
mystring$          ="ceci est un exemple de phrase que je veux decouper "
mystring$=mystring$+"en petit morceaux et y inserer plein de retour a la "
mystring$=mystring$+"ligne pour faire chouette comme vous pouvez le constater"
mystring$=mystring$+" je n'ai pas specialement d'idées pour ecrire cette super"
mystring$=mystring$+" longue phrase et comme je n'ai pas le texte RSS de ARS je"
mystring$=mystring$+" dois donc improviser bien sur je peux aussi copier coller"
mystring$=mystring$+" le texte en entier comme ca j'aurais un super gros texte... c'est ce que je vais faire "
mystring$=mystring$+mystring$
mystring$=mystring$+mystring$
mystring$=mystring$+mystring$
mystring$=mystring$+mystring$
;---------
Repeat
	out$=autoreturn(mystring$,50)								; on met dans out$ la partie de la chaine correspondant a la taille voulue
	Debug out$
	mystring$=Trim(Right(mystring$,Len(mystring$)-Len(out$)))	; on enleve a la chaine originale ainsi que les espace de debut et de fin	
	montext$=montext$+out$+Chr(34)								; on ajoute la chaine de la bonne taille au texte resultat et un retour a la ligne chr(34) ??? 
																; je ne vois pas le raport avec un retour a la ligne avec le chr34 mais cela depend sans doute de l'encodage
																; utilisé par notre cher ami ARS
Until mystring$=""
;---------
Debug montext$