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 : 637
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