MSN DÉGRADÉS DE COULEURS

Public Sub CRGB(ByVal Couleur As Long, Red As Long, Green As Long, Blue As Long)
    
Blue = Int(Couleur / 65536)
Green = Int((Couleur - (65536 * Blue)) / 256)
Red = Couleur - ((Blue * 65536) + (Green * 256))
    
End Sub

Private Sub Form_Load()
Dim texte As String
texte = InputBox("Phrase ?", "Texte à colorer ?", "bonjour !")
If Len(texte) > 68 Then
    MsgBox "Phrase trop longue (> 68 caractères).", vbCritical, "ERREUR"
    Unload Me
    Exit Sub
End If
Dim tableau() As String
ReDim tableau(Len(texte) - 1) As String
Dim num As Byte
For num = 0 To UBound(tableau)
    tableau(num) = Mid(texte, num + 1, 1)
Next
Dim couleurs(5) As Long
MsgBox "Veuillez selectionner la couleur de départ.", vbInformation, "Info"
CDlg1.ShowColor
MsgBox "Veuillez selectionner la couleur d'arrivée.", vbInformation, "Info"
CRGB CDlg1.Color, couleurs(0), couleurs(1), couleurs(2)
CDlg1.ShowColor
CRGB CDlg1.Color, couleurs(3), couleurs(4), couleurs(5)
Dim stat As Byte
Dim rgb(2) As String
Dim tres As String
tres = ""
Dim num2 As Byte
For num = 0 To UBound(tableau)
    rgb(0) = CInt(((num / UBound(tableau)) * couleurs(3)) + ((1 - (num / UBound(tableau))) * couleurs(0)))
    rgb(1) = CInt(((num / UBound(tableau)) * couleurs(4)) + ((1 - (num / UBound(tableau))) * couleurs(1)))
    rgb(2) = CInt(((num / UBound(tableau)) * couleurs(5)) + ((1 - (num / UBound(tableau))) * couleurs(2)))
    For num2 = 0 To 2
        Do While Len(rgb(num2)) < 3
            rgb(num2) = "0" & rgb(num2)
        Loop
    Next
    tres = tres + "(" & rgb(0) & "," & rgb(1) & "," & rgb(2) & ")" & tableau(num)
Next
MsgBox "Résultat mit dans le presse papiers.", vbInformation, "Fin"
Clipboard.Clear
Clipboard.SetText tres
Unload Me
End Sub

Télécharger le zip

15 septembre 2006 15:49:41 :

Modification de la description.