PureBasic

Code : Tout sélectionner

EnableExplicit

Global bactivcolor = 1

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

Procedure.s ValueToColor(icolor)
;
  If Len(Hex(icolor,2)) = 1
    ProcedureReturn "0" + Hex(icolor, 2)
  Else
    ProcedureReturn Hex(icolor, 2)
  EndIf
  
EndProcedure

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

Procedure.s TextToURL(stext.s)
;
  Protected i.i       = 0
  Protected j.i       = 0
  Protected k.i       = 0
  Protected l.i       = 0
  Protected bcolor.b  = 0
  Protected urlnum.i  = 0
  Protected stemp.s   = ""
  Protected stitle.s  = ""
  Protected result.s  = ""
  Protected scolrs.s  = ""
  Protected sChar1.s  = ""
  Protected sChar2.s  = ""
  Protected scolor.s  = ""
  Protected sList1.s  = Chr(34) + "'([{"
  Protected sList2.s  = Chr(34) + "')]}"
  Protected r         = Random(Random(225))
  Protected g         = Random(Random(225))
  Protected b         = Random(Random(225))
  Protected rr        = Random(40) - 20
  Protected gg        = Random(40) - 20
  Protected bb        = Random(40) - 20
  
  If stext <> ""
    urlnum = CountString(stext, " ")
    For i=0 To urlnum
      stemp = StringField(stext, i + 1, " ")
      ;
      sChar1 = ""
      sChar2 = ""
      j = Len(sList1)
      For k=1 To j
        If Left(stemp, 1) = Mid(sList1, k, 1)
          sChar1 = Left(stemp, 1)
          stemp  = Right(stemp, Len(stemp) - 1)
          Break
        EndIf
      Next k
      If sChar1 <> ""
        j = Len(sList2)
        For k=1 To j
          If Right(stemp, 1) = Mid(sList2, k, 1)
            sChar2 = Right(stemp, 1)
            stemp  = Left(stemp, Len(stemp) - 1)
            Break
          EndIf
        Next k
      EndIf
      ;
      If LCase(Left(stemp, 7)) = "http://" Or LCase(Left(stemp, 8)) = "https://" Or LCase(Left(stemp, 4)) = "www."
        bcolor = 1
        If sChar1 = ""
          stitle = stemp
        Else
          stitle = sChar1 + stemp + sChar2
        EndIf
        If LCase(Left(stemp, 4)) <> "www."
          result + "<a href=" + Chr(34) + stemp + Chr(34) + " target=" + Chr(34) + "_blank" + Chr(34) + ">" + stitle + "</a>"
        Else
          result + "<a href=" + Chr(34) + "http://" + stemp + Chr(34) + " target=" + Chr(34) + "_blank" + Chr(34) + ">" + stitle + "</a>"
        EndIf         
      Else
        ;
        ; COLOR
        ;
        If bactivcolor = 1
          scolrs  = ""
          For l=1 To Len(stemp)
            r + rr
            If r > 225 :  rr * -1 : r + rr : EndIf
            If r < 0 :    rr * -1 : r + rr : EndIf
            g + gg
            If g > 225 :  gg * -1 : g + gg : EndIf
            If g < 0 :    gg * -1 : g + gg : EndIf
            b + bb
            If b > 225 :  bb * -1 : b + bb : EndIf
            If b < 0 :    bb * -1 : b + bb : EndIf
            
            scolor = ValueToColor(r)
            scolor + ValueToColor(g)
            scolor + ValueToColor(b)
            
            scolrs + "<span style="  + Chr(34) + "color:#" + scolor + Chr(34) + ">" + Mid(stemp, l, 1) + "</span>"
          Next l
          stemp = scolrs
        EndIf
        ;
        ; COLOR
        ;
        If sChar1 = ""
          result + stemp
        Else
          result + sChar1 + stemp + sChar2
        EndIf
      EndIf
      If i < urlnum
        result + " "
      EndIf
    Next i
    ProcedureReturn result
  EndIf

EndProcedure

; +--------------------------------------------------------------------------+
; |                                                                          |
; +--------------------------------------------------------------------------+

Define Buffer.s = "Cliques sur ce lien https://www.youtube.com/?hl=fr&gl=FR ou sur http://youtube.com ou encore www.koakdesign.info"
Debug TextToURL(Buffer)

Buffer = "https://www.youtube.com/?hl=fr&gl=FR http://youtube.com ou encore www.koakdesign.info"
Debug TextToURL(Buffer)

Define Buffer.s = "Cliques sur ce lien " + Chr(34) + "www.koakdesign.info" + Chr(34) + " "+ Chr(34) + " test" 
Debug TextToURL(Buffer)

Buffer = "Cliques sans Url"
Debug TextToURL(Buffer)

Code : Tout sélectionner

 
 r         = Random(Random(225)) 
 g         = Random(Random(225)) 
 b         = Random(Random(225)) 

Code : Tout sélectionner

Random(225)

Code : Tout sélectionner

Debug ("Egalité pour tous les nombres :")
For i=1 To 100
   ; genere des nombres entre 0 et 100
  Debug Random(100)
Next

Debug ("Ligne oblique :")
For i=1 To 100
   ; genere des nombres plutot proche de 0 que de 100
  Debug Random(Random(100))
Next

Debug ("courbe un peu creusée :")
For i=1 To 100
   ; genere pas mal de nombre proche de 0 et peu pret de 100
  Debug Random(Random(Random(100)))
Next

Debug ("courbe creusée :")
For i=1 To 100
   ; genere beaucoup de nombre proche de 0 et tres peu pret de 100
  Debug Random(Random(Random(Random(100))))
Next

Debug ("courbe très creusée :")
For i=1 To 100
   ; MODE CARNAGE : résultats tous tres tres proche de 0
  Debug Random(Random(Random(Random(Random(100)))))
Next