Procedure 'TextGradient()' texte en dégradé sur le fofo v3

[Ar-S]

Voilà, je voulais m'amuser avec ma signature du forum et du coup j'ai fait cette petite procédure.Y 'a surement plus simple mais j'avais le goût de me faire ça cette aprem, je ne me suis pas cassé la nenette.

-Informations de versions-

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)

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$

[Ar-S]

---- mise à jour V3 ----
Voilà, la version 3, beaucoup plus propre que la précédente du fait de l'utilisation d'une liste précalculée pour créer les dégradés. L'effet est plus propre car le dégradé va maintenant du noir à la couleur et revient vers le noir. J'ai mis à jour le 1er code.

[GallyHC]

Bonjour,

Je vais surement l'utiliser pour un autre forum devine lol

Cordialement,
GallyHC

[Ar-S]

Au hazard, tomtomax ?

[GallyHC]

pt1 tes trop fort je me rend lolllllllllllllllllllll

[Ar-S]

Je termine une petite appli pour le mettre en paratique simplement.

[Kwai chang caine]

Vraiment une super idée
Sur cette même idée, on pourrait faire pleins d'autres choses

Décidément ARS, y'a pas a dire, mais au niveau des idées, ton cerveau c'est un feu d'artifice
Merci de ton partage