Discussion :

[spileo]

Bonsoir,
J'ai programmé une macro qui trace une surface 3D. Je voudrais gérer les couleurs de la légende de ce graphique de manière à avoir un joli dégradé.
Le problème est que le nombre de niveaux dans mon graphique 3D n'est jamais le même. Donc il faut que je recalcule les couleurs de mon dégradé à chaque fois que le nombre de niveaux varie. Pour ce faire, voici comment j'ai procédé.
Au départ, j'ai choisi dans la palette de couleur une saturation et une luminance. Puis en faisant varier la teinte, j'ai trouvé les bornes de mon dégradé.
Le problème est à présent de passer d'un codage TSL à un codage RGB.
En fait c'est juste un changement de repère comme c'est expliqué ici.
Voici le code qui me permet de passer de TSL à RGB:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Option Explicit
Sub degrade()
    Dim T As Integer                'Teinte
    Dim S As Integer                'Saturation
    Dim L As Integer                'Luminance
    Dim T0 As Single
    Dim GM As Single               'Grand M
    Dim pm As Single               'Petit m
    Dim Delta As Single
    Dim Vmax As Integer
    Dim Tmax As Integer
    Dim Lmax As Integer
    Dim Smax As Integer
    Dim i As Integer
    Dim R As Integer
    Dim G As Integer
    Dim B As Integer
 
    Vmax = 255
    Tmax = 240
    Lmax = 240
    Smax = 240
    S = 201
    L = 138
 
    For T = 0 To 175
        T0 = 6 * T / Tmax
        If L <= Lmax / 2 Then
            GM = Vmax * (L / Lmax) * (1 + S / Smax)
            pm = Vmax * (L / Lmax) * (1 - S / Smax)
        ElseIf L > Lmax / 2 Then
            GM = Vmax * ((L / Lmax) * (1 - S / Smax) + S / Smax)
            pm = Vmax * ((L / Lmax) * (1 + S / Smax) - S / Smax)
        End If
        Delta = GM - pm
        i = Int(T0)
        Select Case i
        Case 0
            B = pm
            G = pm + T0 * Delta
            R = GM
        Case 1
            B = pm
            R = pm + (2 - T0) * Delta
            G = GM
        Case 2
            R = pm
            B = pm + (T0 - 2) * Delta
            G = GM
        Case 3
            R = pm
            G = pm + (4 - T0) * Delta
            B = GM
        Case 4
            G = pm
            R = pm + (T0 - 4) * Delta
            B = GM
        Case 5
            G = pm
            B = pm + (6 - T0) * Delta
            R = GM
        End Select
        Application.Workbooks(1).Worksheets(1).Cells(T + 1, 1).Interior.Color = RGB(R, G, B)
    Next
 
End Sub

Cela fonctionne mais ne me donne pas entièrement satisfaction: les changements de couleur sont trop brusques, on dirait qu'il n'y a pas de réel dégradé.
J'ai cherché sur le forum mais j'ai pas trouvé grand chose sur les dégradés et le tutoriel de SilkyRoad ne correspond pas vraiment à ce que je veux faire.
Merci.

[spileo]

Bonjour,
en fait j'ai trouvé.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 
Option Explicit
Dim tableau(0 To 175) As Control
Sub degrade()
    Dim T As Integer                'Teinte
    Dim S As Integer                'Saturation
    Dim L As Integer                'Luminance
    Dim T0 As Single
    Dim GM As Single
    Dim pm As Single
    Dim Delta As Single
    Dim Vmax As Integer
    Dim Tmax As Integer
    Dim Lmax As Integer
    Dim Smax As Integer
    Dim i As Integer
    Dim R As Integer
    Dim G As Integer
    Dim B As Integer
 
    Vmax = 255
    Tmax = 240
    Lmax = 240
    Smax = 240
    S = 201
    L = 138
 
 
 
 
    For T = 0 To 175
        T0 = 6 * T / Tmax
        If L <= Lmax / 2 Then
            GM = Vmax * (L / Lmax) * (1 + S / Smax)
            pm = Vmax * (L / Lmax) * (1 - S / Smax)
        ElseIf L > Lmax / 2 Then
            GM = Vmax * ((L / Lmax) * (1 - S / Smax) + S / Smax)
            pm = Vmax * ((L / Lmax) * (1 + S / Smax) - S / Smax)
        End If
        Delta = GM - pm
        i = Int(T0)
        Select Case i
        Case 0
            B = pm
            G = pm + T0 * Delta
            R = GM
        Case 1
            B = pm
            R = pm + (2 - T0) * Delta
            G = GM
        Case 2
            R = pm
            B = pm + (T0 - 2) * Delta
            G = GM
        Case 3
            R = pm
            G = pm + (4 - T0) * Delta
            B = GM
        Case 4
            G = pm
            R = pm + (T0 - 4) * Delta
            B = GM
        Case 5
            G = pm
            B = pm + (6 - T0) * Delta
            R = GM
        End Select
        Set tableau(T) = UserForm1.Controls.Add("Forms.Label.1")
        tableau(T).Height = 2
        If T > 0 Then
            tableau(T).Top = tableau(T - 1).Height + tableau(T - 1).Top
        End If
        tableau(T).BackColor = RGB(R, G, B)
        UserForm1.Height = tableau(T).Top + tableau(T).Height
    Next
    UserForm1.Show
End Sub

Pour tester il suffit de mettre ce code dans un module de code et d'insérer une UserForm au projet nommé UserForm1.
Cela provoque un dégradé de couleurs du Rouge vers le bleu.
J'espère que ce code servira à quelqu'un.
Bonne journée.