PureBasic

Code : Tout sélectionner

Procedure.s TextGradient(messageaclolorer$,RGBchoice$="B") 
  
  ; Par Ar-S / oct 2011
  ; V3 Création d'une liste avec les valeurs couleur pour un meilleur rendu
  ; V2 ajout des dégradés vers jaune et magenta
  ; V1 gestion du RVB (RGB)
  
  ; RGBchoice$ - B by default (blue)
  ; Options 
  ;  "R" For red/rouge
  ;  "G"  or "V" For green/vert
  ;  "B" For blue/bleu
  ;  "Y" or "J" for yellow/jaune
  ;  "M" for magenta
  
  ; ex : Result$ = TextGradient(mytext$,"R") ; to make a black to red Gradient text
 
  ; -----------------------------
  ; initialisation
  ARS_TXTcouleur$ = ""
  ARS_Bfin$ = "[/color]"
  ARS_lng.l = Len(messageaclolorer$)
  ARS_GammeCouleur$ = RGBchoice$
  ARS_i = 1
  Global NewList Couleurs.s()
  ; ------------------------------
  
  
  
  
  ; Création de la liste des couleurs de 0 à 255 à 1
  ; la valeur 'step' peut être modifiée
  ; Plus la valeur est grande, plus le dégradé est rapide (pour les textes courts)
  ; Recommandé : 
  ; - textes courts : 3
  ; - texte long : 1

  For i = 0 To 255 Step 3

    L$ = Hex(i,#PB_Byte)
    If Len(L$) < 2
      L$ = "0"+L$
    EndIf

    AddElement(Couleurs())
    Couleurs() = L$
  Next
  
  For j = 254 To 1 Step -3
    
    L$ = Hex(j,#PB_Byte)
    If Len(L$) < 2
      L$ = "0"+L$
    EndIf
    
    AddElement(Couleurs())
    Couleurs() = L$
  Next
  ; -------------------------------
  
  
  
  ; Boucle qui colorise -------
  ResetList(Couleurs())
  CouleurEnCours.l = 0
  ARS_NbrCouleurs.l = ListSize(Couleurs())
  
  For i = 1 To ARS_lng
    
    ; Lecture lettre à lettre
    ARS_Lettre$ = Mid(messageaclolorer$,i,1)
    
    ; Gestion de la couleur
    
    SelectElement(Couleurs(),CouleurEnCours)
     
    ; Formatage des balises bbcodes
    If ARS_GammeCouleur$ = "R" ; Rouge  
      ARS_B1$ = "[color=#"+Couleurs()+"0000]"
      
    ElseIf ARS_GammeCouleur$ = "G" Or ARS_GammeCouleur$ = "V" ; Vert
      ARS_B1$ = "[color=#00"+Couleurs()+"00]"
      
    ElseIf ARS_GammeCouleur$ = "B" ; Bleu
      ARS_B1$ = "[color=#0000"+Couleurs()+"]"
      
    ElseIf ARS_GammeCouleur$ = "Y" Or ARS_GammeCouleur$ = "J"  
      ARS_B1$ = "[color=#"+Couleurs()+Couleurs()+"00]"
      
    ElseIf ARS_GammeCouleur$ = "M"  
      ARS_B1$ = "[color=#"+Couleurs()+"00"+Couleurs()+"]"  
      
    Else
      ; Sinon par defaut on utilise le Bleu
      ARS_B1$ = "[color=#0000"+Couleurs()+"]"
    EndIf
    ; ---------------------
    
    
    ; Affichage du bbcode complet
    ARS_Lettre$ = ARS_B1$+ARS_Lettre$+ARS_Bfin$
    ARS_TXTcouleur$ + ARS_Lettre$
    ; ---------------------
    
    
    CouleurEnCours + 1
    
    If CouleurEnCours = ARS_NbrCouleurs
      CouleurEnCours = 0
    EndIf
    
  Next
  
  If ARS_TXTcouleur$ = ""
    ProcedureReturn "erreur"
  Else
    ProcedureReturn ARS_TXTcouleur$
  EndIf  
  
EndProcedure

; Exemples 

texte$ = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz"
texte$+Chr(10)+texte$

Result$ = TextGradient(texte$,"B") ; ou TextGradient(texte$) car bleu est la couleur par defaut
SetClipboardText(Result$)
Debug Result$