Discussion :

[julius1983]

Bonjour à tous,

Je vous contacte parce que j'aimerais colorier une texture en une autre texture avec une autre couleur (image teintée).
Voici ce que j'aimerais faire :

https://i.postimg.cc/MKrdM8hX/fond.png

Dans l'attente d'une aide précieuse,

A+

[SergioMaster]

Bonjour,

Il serait peut être bon de nous indiquer quelle version de Delphi et quel Framework avant que nous nous lancions dans des hypothèses

[Charly910]

Bonjour,
ce serait peut être plus facile avec un logiciel de dessin ?

A+
Charly

[julius1983]

Salut à tous,

En fait je cherche à teinter une texture avec une autre couleur.

Merci à vous,

A+

[Charly910]

Bonjour,

voici fait rapidement avec PSP. Y a t il une raison particulière pour que tu veuille le faire avec Delphi ?



Avec Delphi c'est possible, mais plus compliqué. Il faut jouer avec le RGB des pixels. Regarde la propriété Scanline par exemple qui permet d'accéder rapidement aux lignes de pixels.

et cette discussion si tu veux convertir ta texture en niveaux de gris ?

A+
Charly

[tourlourou]

Pour modifier la couleur sans trop altérer la luminosité, il peut être pertinent de convertir la valeur des pixels de Rouge-Vert-Bleu en Teinte-Saturation-Luminosité, modifier le paramètre teinte comme souhaité, et faire la conversion inverse pour affecter les nouvelles valeurs.

[Charly910]

Bonjour,

Voici un essai de conversion en nuance de gris, inspiré de Phidels et des coeff de conversion trouvés sur le net :

Texture.zip

A+
Charly

[Jipété]

Yop !

Pour les nuances de gris, voilà ce que je trouve dans l'aide de The Gimp :

Lightness
The graylevel will be calculated as
Lightness = ½ × (max(R,G,B) + min(R,G,B))

Luminosity
The graylevel will be calculated as
Luminosity = 0.21 × R + 0.72 × G + 0.07 × B

Average
The graylevel will be calculated as
Average Brightness = (R + G + B) ÷ 3

Si ça peut aider...

[tourlourou]

Voici un petit code pour modifier la teinte : [EDIT = ajout modification if Hnew = 0 then S := 0; pour bien gérer les gris]

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
const
  Fichier = 'E:\Bureau\fond_2.bmp';
 
procedure TForm1.Button1Click(Sender: TObject);
var
  bmp: TBitmap;
begin
  Image1.Picture.LoadFromFile(ChangeFileExt(Fichier, '.png'));
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24Bit;
  bmp.Height := Image1.Picture.Height;
  bmp.Width := Image1.Picture.Width;
  bmp.Canvas.Draw(0, 0, Image1.Picture.Graphic);
  bmp.SaveToFile(Fichier);
  bmp.Free;
  Image1.Picture.Assign(nil);
end;
 
procedure TForm1.Button2Click(Sender: TObject);
type
  TRGBTripleArray = ARRAY[Word] of TRGBTriple;
var
  x, y, H, S, L, Hmin, Hmax, Hmoy, Hnew: integer;
  P: ^TRGBTripleArray;
  TheColor: TColor;
begin
  Image1.Picture.LoadFromFile(Fichier);
  // recherche de la teinte moyenne
  Hmin := Maxint;
  Hmax := -(Maxint-1);
  for y := 0 to Image1.Picture.Height-1 do begin
    P := Image1.Picture.Bitmap.ScanLine[y];
    for x := 0 to Image1.Picture.Width-1 do begin
      RGBTripleToHSL(P[x], H, S, L);
      Hmin := Min(Hmin, H);
      Hmax := Max(Hmax, H);
    end;
  end;
  ShowMessage( IntToStr(Hmin) + ' / ' + IntToStr(Hmax) );
  Hmoy := ( Hmin + Hmax ) div 2;
  ShowMessage( IntToStr(Hmoy) );
 
  // choix d'une nouvelle teinte
  if not ColorDialog1.Execute then exit;
  TheColor := ColorDialog1.Color;
  Hnew := GetHValue(TheColor);
  ShowMessage(IntToStr(Hnew));
 
  // application de la nouvelle teinte
  for y := 0 to Image1.Picture.Height-1 do
    for x := 0 to Image1.Picture.Width-1 do begin
      RGBtoHSLRange(Image1.Canvas.Pixels[x, y], H, S, L);
      if Hnew = 0 then
        S := 0; // pour le gris
      Image1.Canvas.Pixels[x, y] := HSLRangeToRGB(Hnew, S, L);
    end;
end;

Il utilise l'unité RGBHSLUtils trouvée ici, modifiée de l'ajout des fonctions RGBToRGBTriple et RGBToRGBQuad qui doivent figurer dans l'unité Scanlines non trouvée :

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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
unit RGBHSLUtils;
 
// https://www.delphipraxis.net/157099-fast-integer-rgb-hsl.html
 
interface
 
uses
 Windows, Graphics, UITypes, Math; //, Scanlines;
 
var //set these variables to your needs, e.g. 360, 255, 255
 MaxHue: integer = 239;
 MaxSat: integer = 240;
 MaxLum: integer = 240;
 
function HSLtoRGB (H, S, L: double): TColor;
function HSLRangeToRGB (H, S, L: integer): TColor;
procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer);
function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): integer;
procedure Clamp(var Input: integer; Min, Max: integer);
function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
 
implementation
 
function RGBToRGBTriple(aR, aG, aB: integer): TRGBTriple;
begin
  Result.rgbtBlue := aB;
  Result.rgbtGreen := aG;
  Result.rgbtRed := aR;
end;
 
function RGBToRGBQuad(aR, aG, aB: integer): TRGBQuad;
begin
  Result.rgbBlue := aB;
  Result.rgbGreen := aG;
  Result.rgbRed := aR;
end;
 
function HSLtoRGB(H, S, L: double): TColor;
var
 M1, M2: double;
 
  function HueToColorValue(Hue: double): byte;
  var
   V : double;
  begin
   if Hue < 0 then
    Hue := Hue + 1
   else
    if Hue > 1 then
     Hue := Hue - 1;
   if 6 * Hue < 1 then
    V := M1 + (M2 - M1) * Hue * 6
   else
    if 2 * Hue < 1 then
     V := M2
    else
     if 3 * Hue < 2 then
      V := M1 + (M2 - M1) * (2/3 - Hue) * 6
     else
      V := M1;
   Result := round (255 * V)
  end;
 
var
 R, G, B: byte;
begin
 if S = 0 then
  begin
   R := round (MaxLum * L);
   G := R;
   B := R
  end
 else
  begin
   if L <= 0.5 then
    M2 := L * (1 + S)
   else
    M2 := L + S - L * S;
   M1 := 2 * L - M2;
   R := HueToColorValue (H + 1/3);
   G := HueToColorValue (H);
   B := HueToColorValue (H - 1/3)
  end;
 Result := RGB (R, G, B)
end;
 
function HSLRangeToRGB(H, S, L : integer): TColor;
begin
 if s > MaxSat then s := MaxSat;
 if s < 0 then s := 0;
 if l > MaxLum then l := MaxLum;
 if l < 0 then l := 0;
 Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end;
 
procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1 : integer);
var
  R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
 H := h1;
 S := s1;
 L := l1;
 R := GetRValue (RGB) / 255;
 G := GetGValue (RGB) / 255;
 B := GetBValue (RGB) / 255;
 Cmax := Max (R, Max (G, B));
 Cmin := Min (R, Min (G, B));
 L := (Cmax + Cmin) / 2;
 if Cmax = Cmin then
  begin
   H := 0;
   S := 0;
  end
 else
  begin
   D := Cmax - Cmin;
   //calc L
   if L < 0.5 then
    S := D / (Cmax + Cmin)
   else
    S := D / (2 - Cmax - Cmin);
   //calc H
   if R = Cmax then
    H := (G - B) / D
   else
    if G = Cmax then
     H := 2 + (B - R) /D
    else
     H := 4 + (R - G) / D;
   H := H / 6;
   if H < 0 then
    H := H + 1;
  end;
 H1 := round (H * MaxHue);
 S1 := round (S * MaxSat);
 L1 := round (L * MaxLum);
end;
 
function GetHValue(AColor: TColor): integer;
var
 d, h: integer;
begin
 RGBToHSLRange(AColor, h, d, d);
 Result := h;
end;
 
function GetSValue(AColor: TColor): integer;
var
 d, s: integer;
begin
 RGBToHSLRange(AColor, d, s, d);
 Result := s;
end;
 
function GetLValue(AColor: TColor): integer;
var
 d, l: integer;
begin
 RGBToHSLRange(AColor, d, d, l);
 Result := l;
end;
 
procedure Clamp(var Input: integer; Min, Max: integer);
begin
 if (Input < Min) then Input := Min;
 if (Input > Max) then Input := Max;
end;
 
function HSLToRGBTriple(H, S, L: integer): TRGBTriple;
const
 Divisor = 255*60;
var
 hTemp, f, LS, p, q, r: integer;
begin
 Clamp(H, 0, MaxHue);
 Clamp(S, 0, MaxSat);
 Clamp(L, 0, MaxLum);
 if (S = 0) then
   Result := RGBToRGBTriple(L, L, L)
 else
  begin
   hTemp := H mod MaxHue;
   f := hTemp mod 60;
   hTemp := hTemp div 60;
   LS := L*S;
   p := L - LS div MaxLum;
   q := L - (LS*f) div Divisor;
   r := L - (LS*(60 - f)) div Divisor;
   case hTemp of
    0: Result := RGBToRGBTriple(L, r, p);
    1: Result := RGBToRGBTriple(q, L, p);
    2: Result := RGBToRGBTriple(p, L, r);
    3: Result := RGBToRGBTriple(p, q, L);
    4: Result := RGBToRGBTriple(r, p, L);
    5: Result := RGBToRGBTriple(L, p, q);
   else
    Result := RGBToRGBTriple(0, 0, 0);
   end;
  end;
end;
 
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
const
 Divisor = 255*60;
var
 hTemp, f, LS, p, q, r: integer;
begin
 Clamp(H, 0, MaxHue);
 Clamp(S, 0, MaxSat);
 Clamp(L, 0, MaxLum);
 if (S = 0) then
   Result := RGBToRGBQuad(L, L, L)
 else
  begin
   hTemp := H mod MaxHue;
   f := hTemp mod 60;
   hTemp := hTemp div 60;
   LS := L*S;
   p := L - LS div MaxLum;
   q := L - (LS*f) div Divisor;
   r := L - (LS*(60 - f)) div Divisor;
   case hTemp of
    0: Result := RGBToRGBQuad(L, r, p);
    1: Result := RGBToRGBQuad(q, L, p);
    2: Result := RGBToRGBQuad(p, L, r);
    3: Result := RGBToRGBQuad(p, q, L);
    4: Result := RGBToRGBQuad(r, p, L);
    5: Result := RGBToRGBQuad(L, p, q);
   else
    Result := RGBToRGBQuad(0, 0, 0);
   end;
  end;
end;
 
procedure RGBTripleToHSL(RGBTriple: TRGBTriple; var h, s, l: integer);
 
 function RGBMaxValue(RGB: TRGBTriple): byte;
 begin
  Result := RGB.rgbtRed;
  if (Result < RGB.rgbtGreen) then Result := RGB.rgbtGreen;
  if (Result < RGB.rgbtBlue) then Result := RGB.rgbtBlue;
 end;
 
 function RGBMinValue(RGB: TRGBTriple) : byte;
 begin
  Result := RGB.rgbtRed;
  if (Result > RGB.rgbtGreen) then Result := RGB.rgbtGreen;
  if (Result > RGB.rgbtBlue) then Result := RGB.rgbtBlue;
 end;
var
 Delta, Min: byte;
begin
 L := RGBMaxValue(RGBTriple);
 Min := RGBMinValue(RGBTriple);
 Delta := L-Min;
 if (L = Min) then
  begin
   H := 0;
   S := 0;
  end
 else
  begin
   S := MulDiv(Delta, 255, L);
   with RGBTriple do
    begin
     if (rgbtRed = L) then
      H := MulDiv(60, rgbtGreen-rgbtBlue, Delta)
     else
      if (rgbtGreen = L) then
       H := MulDiv(60, rgbtBlue-rgbtRed, Delta) + 120
      else
       if (rgbtBlue = L) then
        H := MulDiv(60, rgbtRed-rgbtGreen, Delta) + 240;
     if (H < 0) then H := H + 360;
    end;
  end;
end;
 
end.

[Charly910]

Bonjour,

petit programme modifié, un peu fouillis, avec en plus la méthode proposée par Tourlourou et aussi la modification des composantes RGB

Texture1.zip

Mais il faudrait savoir exactement ce qu'attend le demandeur.

A+
Charly

[SergioMaster]

Bonjour,

J'insiste

Il serait peut être bon de nous indiquer quelle version de Delphi et quel Framework avant que nous nous lancions dans des hypothèses

Apparemment, au vu des autres messages sur le forum, vous travaillez avec FMX et très certainement une des dernières versions
Je suis étonné que l'utilisation d'effets ne vous soit pas venue à l'idée par exemple TMonochromeEffect pour des nuances de gris
mais aussi, (en passant par quelques étapes) en utilisant un TColorAlphaEffect pour obtenir une texture avec une couleur transparente suivie d'un TNormalBlendEffect pour fusionner l'image obtenue dans une autre image