RGB to TSL - TSL to RGB

**BuzzLeclaire** · 07/11/2008, 14h33

Bonjour,
Je cherchais comment rendre une couleur de départ en couleur pastel. Je me suis rendu compte qu'une couleur pastelle avait une luminausité de 200 minimum.

En cherchant sur le net j'ai trouvé pas mal de procédure, après avoir pioché partout j'en est repris plusieur que j'ai corrigé (enfin pas beaucoup).

Le but de la manoeuvre de cet unité est de transformer une couleur de base en pastel.

Créer un form, poser 2 panel (panel1 et panel2) relié la procédure Doubleclique du panel1 de l'unit.

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Math;

type
  TForm1 = class(TForm)
    ColorDialog1: TColorDialog;
    Panel1: TPanel;
    Panel2: TPanel;
    Procedure RGB_To_TSL(R, G, B: Integer; Out T, S, L: Integer);
    Procedure TSL_To_RGB(T, S, L: Integer; Out R, G, B: Integer);
    procedure Panel1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Panel1DblClick(Sender: TObject);
Var
T,L,S : Integer;
R,G,B: Integer;
begin

  if (ColorDialog1.Execute) then
  Begin
    Panel1.Color := ColorDialog1.Color; // On récupère la valeur 

    RGB_To_TSL(
    GetRValue(ColorToRGB(ColorDialog1.Color)),
    GetGValue(ColorToRGB(ColorDialog1.Color)),
    GetBValue(ColorToRGB(ColorDialog1.Color)),
    T,S,L);

    TSL_To_RGB(T,S,210,R,G,B); // On force la luminausité à 210 pour le pastel

    Panel2.Color := RGB(R,G,B);

  end;
end;

Function Htorgb(n1, n2, hue: word): word;
Const
  HLSMAX = 240;
Begin

  If hue < 0 Then hue := HLSMAX + hue;
  If hue > HLSMAX Then hue := hue - HLSMAX;

  If hue < ((HLSMAX * 2) Div 3) Then
    Begin
      If hue < (HLSMAX Div 2) Then
        Begin
          If hue < (HLSMAX Div 6) Then
            result := (n1 + (((n2 - n1) * hue + (HLSMAX Div 12)) Div (HLSMAX Div
            6)))
          Else result := n2;
        End
      Else
        result := (n1 + (((n2 - n1) * (((HLSMAX * 2) Div 3) - hue) + (HLSMAX Div
          12)) Div (HLSMAX Div 6)));
    End
  Else
    result := n1;
End;

//
// Trouvé sur se lien PAr CIREC
// J'ai corriger le S et le L qui était à l'envers

Procedure Tform1.RGB_To_TSL(R, G, B: Integer; Out T, S, L: Integer);
Const
  HLSMAX            = 240;
  RGBMAX            = 255;
Var
  rgb               : Array[1..3] Of byte;
  cMax, cMin        : byte;
  i                 : byte;
  Rdelta, Gdelta, Bdelta: integer;
Begin
  rgb[1] := r;
  rgb[2] := g;
  rgb[3] := b;

  cMax := rgb[1];
  cMin := rgb[1];

  For i := 2 To 3 Do
    Begin
      If cMax < rgb[i] Then cMax := rgb[i];
      If cMin > rgb[i] Then cMin := rgb[i];
    End;
  L := (((cMax + cMin) * HLSMAX) + RGBMAX) Div (2 * RGBMAX);
  If cMax = Cmin Then
    Begin
      S := 0;
      T := 160;
    End
  Else
    Begin
      If (L <= (HLSMAX Div 2)) Then
        Begin
          S := (((cMax - cMin) * HLSMAX) + ((cMax + cMin) Div 2)) Div (cMax +
            cMin);
        End
      Else
        Begin
          S := (((cMax - cMin) * HLSMAX) + ((2 * RGBMAX - cMax - cMin) Div 2))
            Div (2 * RGBMAX - cMax - cMin);
        End;

      Rdelta := (((cMax - r) * (HLSMAX Div 6)) + ((cMax - cMin) Div 2)) Div (cMax
        - cMin);
      Gdelta := (((cMax - g) * (HLSMAX Div 6)) + ((cMax - cMin) Div 2)) Div (cMax
        - cMin);
      Bdelta := (((cMax - b) * (HLSMAX Div 6)) + ((cMax - cMin) Div 2)) Div (cMax
        - cMin);

      If r = cMax Then T := Bdelta - Gdelta
      Else If g = cMax Then T := (HLSMAX Div 3) + Rdelta - Bdelta
      Else T := ((2 * HLSMAX) Div 3) + Gdelta - Rdelta;
      If T < 0 Then T := HLSMAX + T;
    End;
End;

//
// Trouvé sur se lien PAr CIREC

Procedure TForm1.TSL_To_RGB(T, S, L: Integer; Out R, G, B: Integer);
Const
  HLSMAX            = 240;
  RGBMAX            = 255;
Var
  Magic1, Magic2    : word;
Begin
  If S = 0 Then
    Begin
      r := (L * RGBMAX) Div HLSMAX;
      g := r;
      b := r;
    End
  Else
    Begin
      If L <= (HLSMAX Div 2) Then
        Begin
          Magic2 := (L * (HLSMAX + S) + (HLSMAX Div 2)) Div HLSMAX;
        End
      Else
        Begin
          Magic2 := L + S - ((L * S) + (HLSMAX Div 2)) Div HLSMAX;
        End;

      Magic1 := 2 * L - Magic2;
      r := (Htorgb(Magic1, Magic2, T + (HLSMAX Div 3)) * RGBMAX + (HLSMAX Div 2))
        Div HLSMAX;
      g := (Htorgb(Magic1, Magic2, T) * RGBMAX + (HLSMAX Div 2)) Div HLSMAX;
      b := (Htorgb(Magic1, Magic2, T - (HLSMAX Div 3)) * RGBMAX + (HLSMAX Div 2))
        Div HLSMAX;
    End;
End;


End.


end.

Je n'ai rien inventé, les procédures trouvées avaient elle même été récupéré.

Je donne juste l'info, car je me suis pris la tête pendant 3 heures, et je pense que cela peu aider.

**Pedro** · 07/11/2008, 18h25

Merci pour ta participation

**mick605** · 11/06/2009, 01h28

Salut !

Je suis assez dégouté, apres avoir cherché tres longtemps CETTE procedure, je me suis décidé a la faire tout seul avec Wikipedia !

Mais je ne me souviens plus si HSL c'est l'anglais de TSL (Teinte Saturation Luminosité) ...

Donc la je vous donne une Unité que j'ai fait, assez utile pour tout ce qui est retouche d'image ...

Si vous avez des idées de procedures, ou des remarques, faites le moi savoir !

**Pedro** · 19/06/2009, 18h52

Merci

**Dr.Who** · 25/09/2009, 18h04

Hehe c'est sympa de mettre un liens vers ma source

(sans me citer par contre)
il est vrai que Cirec m'avait bien aidé pour le coups à déboguer les fonctions.

**ShaiLeTroll** · 25/09/2009, 18h26

Vous savez quand même que le code est fourni dans l'aide SDK de Delphi ?
voir la rubrique : "Converting Colors Between RGB and HLS (HBS)" que l'on trouve avec la recherche en indiquant "RGB HLS" code qui évidemment présent dans Delphi dans GraphUtil avec les fonctions ColorRGBToHLS et ColorHLSToRGB ... ah réinventez la roue carrée c'est vrai que c'est bien fun

!
Et déclarer que c'est "son code" lorsque l'on a juste traduit le code fourni par la SDK Win32 ou par Delphi , je trouve qu'il vaut mieux se taire !
Donc redonnons à César, ce qui appartient à J. Foley and A.Van Dam !

Même si l'aide de Delphi 7 est très très bien fournie, il y a beaucoup d'unités qui ne sont pas documentées et dans tous les domaines, Graphiques, Encodage, Math, Date, Internet, ...

**mick605** · 25/09/2009, 20h40

Yeah, merci Shai !

Mais franchement, j'ai eu beau chercher (aide Delphi, Dev.com, google ...), j'ai pas trouvé tout ca ! Mais ca m'étonnais aussi que Delphi ait pas pensé a ca ... En tout cas super, et merci (je ne connaissais meme pas l'existence de ces unités)

**ShaiLeTroll** · 28/09/2009, 10h18

@mick605, comme moi, j'ai aussi cherché, plus par curiosité, que par besoin, et depuis 2-3 ans, je fouille dans le répertoire Delphi, et l'on trouve son bonheur, comme un jour, j'ai trouvé EncdDecd pour l'encodage en Base64, falait bien que cela existe pour les Header HTTP ou le SOAP ... dont tu ne trouve pas la documentation de la VCL mais la version Indy qui a été réécrite ... tu ne trouves pas tout mais tu as certains basiques insoupçonnés ... d'ailleurs dans le genre l'unité TypInfo n'est pas la mieux documentée ... ou les fonctions TryStr ... leur apparition est survenu d'un coup, et pas évident de savoir qu'elle existait déjà avant qu'elle soit documentée ...

[HS]
Je me dois de conserver mon statut de Troll

, donc je dois raler un minimum et j'avoue qu'une revendication dans ce genre m'a titillé mes neurones de chieur

[/HS]

**Dr.Who** · 28/09/2009, 17h59

je rejoins Shay pour dire qu'il existe un grand nombre d'unité non documentée sur delphi et c'est dommage.

si on ne cherche pas par soit même dans le repertoire Source ou dans l'aide (pour les unité ou fonction qui sont "citée" mais pas expliquées) on passe a coté de nombreuses choses utile.

rien que dans System ou SysUtils grand nombre de fonctions passent inaperçue.

les unités comme DateUtils, StrUtils, GraphUtils sont souvent ignorées. Beaucoup n'installent pas non plus l'aide du SDK windows pourtant trés utile!
Beaucoup ne savent pas qu'on peut faire F1 sur l'identifiant d'une fonction pour lancer l'aide sur cette fonction.
Beaucoup non pas la curiosité de faire "chercher la declaration" (clique droit sur un elements du code) pour aller voir le contenus et alentours dans l'unité.

C'est l'exemple même de TypInfo et IntfInfo ... si on ne vas pas voir dedans, difficile de savoir a quoi elles servent.
Tout comme la ShellApi et autre truc commençant par sh! pourtant trés utile!

[hs]
Aucuns malentendus entre nous, c'est souvent sur des quiproquos qu'on apprend à se connaitre

Donc sans rancune.
[/hs]

**mick605** · 28/09/2009, 18h53

Tiens, j'avais meme pas pensé a aller chercher dans le répertoire "Source" .... La prochaine fois, j'irais

**Andnotor** · 28/09/2009, 21h15

Envoyé par Dr.Who

... j'aurais pourtant juré avoir écris "ma source" (...) et non "MON code" ...

Plutôt mysogine ton truc

.

**Dr.Who** · 29/09/2009, 00h13

j'aurais plutôt dis de la misandrie ...

**BuzzLeclaire** · 30/09/2009, 22h29

Salut Docteur Who je suis désolé pour avior homis de te cité. Ceci dit Cirec ne le dit pas non plus...

Bref, il est à noter que j'ai juste corriger une erreur qui n'ajoute rien à ce travail fabuleux. (enfin si tu corrige pas sa marche à l'envers lololol)

bye...

**Paul TOTH** · 27/02/2019, 22h44

Et 10 ans plus tard je m'y intéresse

voici une version plus compacte et qui optimise les calculs

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
78
79
80
81
82
83
84
85
 
procedure RGBtoHSL(R, G, B: Integer; var H, S, L: Integer);
var
  min, max: Integer;
  delta: Integer;
  dr, dg, db: Integer;
begin
  max := System.Math.Max(System.Math.Max(R, G), B);
  min := System.Math.Min(System.Math.Min(R, G), B);
  delta := max - min;
 
  S := max + min;
  L := ((S * 240) + 255) div 510;
 
  if delta = 0 then
  begin
    S := 0;
    H := 160;
  end else begin
    if L > 120 then
      S := 510 - S;
    S := ((delta * 240) + (S div 2)) div S;
 
    dr := (((max - R) * 40) + (delta div 2) ) div delta;
    dg := (((max - G) * 40) + (delta div 2) ) div delta;
    db := (((max - B) * 40) + (delta div 2) ) div delta;
 
    if R = max then
      H := db - dg
    else
    if G = max then
      H := 80 + dr - db
    else // B == max
      H := 160 + dg - dr;
 
    if (H < 0) then
      H := H + 240
    else
    if (H > 240) then
      H := H - 240;
  end;
end;
 
function HSLToChroma(H, S, L: Integer): Integer;
begin
  if H < 0 then
     H := H + 240
  else
  if H > 240 then
    H := H - 240;
 
  if H < 40 then
    Inc(L, ((S - L) * H + 20) div 40)
  else
  if H < 120 then
    L := S
  else
  if H < 160 then
    Inc(L, ((S - L) * (160 - H) + 20) div 40 );
 
  Result := ((L * 255) + 120) div 240;
end;
 
procedure HSLtoRGB(H, S, L: Integer; var R, G, B: Integer);
var
  magic1: Integer;
  magic2: Integer;
begin
  if S = 0 then
  begin
    R := (L * 255) div 240;
    G := R;
    B := R;
  end else begin
    if L <= 120 then
      magic2 := (L * (240 + S) + 120) div 240
    else
      magic2 := L + S - ((L * S) + 120) div 240;
    magic1 := 2 * L - magic2;
 
    R := HSLToChroma(H + 80, magic2, magic1);
    G := HSLToChroma(H     , magic2, magic1);
    B := HSLToChroma(H - 80, magic2, magic1);
  end;
end;

**Roland Chastain** · 02/03/2019, 00h59

Question bête. Quel genre de choses peut-on faire avec ces fonctions ?

**Paul TOTH** · 02/03/2019, 13h19

Envoyé par Roland Chastain

Question bête. Quel genre de choses peut-on faire avec ces fonctions ?

Alors j'avais un besoin très spécifique, je génère une icône représentant une annotation, c'est un carré de couleur avec le coin plié dans une couleur plus sombre que la couleur de base qui est paramétrable... Ok mais quelle couleur prendre pour ce coin ?

En partant de RGB c'est compliqué, alors qu'en HSL il suffit de baisser L (luminosité) pour avoir une couleur dans la même gamme mais en plus sombre... Du coup je transforme ma couleur en HSL, je baisse L et la retransforme en RGB.

Exemple, je pars de la couleur orangée RGB(255, 176, 25) en réduisant L de 40 j'obtiens RGB(196, 128, 0).

Nom : RGBHSL.jpg
Affichages : 539
Taille : 8,4 Ko

**Roland Chastain** · 03/03/2019, 08h01

Vu. Merci Paul.

RGB to TSL - TSL to RGB

Contribuez Delphi

Discussions similaires

Partager

Partager