1// SPDX-License-Identifier: LGPL-3.0-linking-exception
2{$IFDEF INCLUDE_INTERFACE}
3{$UNDEF INCLUDE_INTERFACE}
4type
5  {* Possible channels in a bitmap using any RGBA colorspace }
6  TChannel = (cRed, cGreen, cBlue, cAlpha);
7  {** Combination of channels }
8  TChannels = set of TChannel;
9
10const
11  TBGRAPixel_ChannelByteOffset : array[TChannel] of integer =
12  (TBGRAPixel_RedByteOffset, TBGRAPixel_GreenByteOffset, TBGRAPixel_BlueByteOffset, TBGRAPixel_AlphaByteOffset);
13
14{ Gamma conversion arrays. Should be used as readonly }
15var
16  // TBGRAPixel -> TExpandedPixel
17  GammaExpansionTab:     packed array[0..255] of word;
18  GammaExpansionTabHalf: packed array[0..254] of word;
19
20  // TExpandedPixel -> TBGRAPixel
21  GammaCompressionTab : packed array[0..65535] of byte;          //rounded value
22
23procedure BGRASetGamma(AGamma: single = 1.7);
24function BGRAGetGamma: single;
25
26type
27  PExpandedPixel = ^TExpandedPixel;
28  { TExpandedPixel }
29  {* Stores a gamma expanded RGB color. Values range from 0 to 65535 }
30  TExpandedPixel = packed record
31    red, green, blue, alpha: word;
32  end;
33  TExpandedPixelBuffer = packed array of TExpandedPixel;
34
35  procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer; ASize: integer);
36
37  {** Converts a pixel from sRGB to gamma expanded RGB }
38  function GammaExpansion(c: TBGRAPixel): TExpandedPixel; inline;
39  {** Converts a pixel from gamma expanded RGB to sRGB }
40  function GammaCompression(const ec: TExpandedPixel): TBGRAPixel; inline; overload;
41  {** Converts a pixel from gamma expanded RGB to sRGB }
42  function GammaCompression(red,green,blue,alpha: word): TBGRAPixel; inline; overload;
43  {** Apply gamma compression with word values }
44  function GammaCompressionW(AExpanded: word): word;
45  {** Apply gamma expansion with word values }
46  function GammaExpansionW(ACompressed: word): word;
47  {** Returns the intensity of an gamma-expanded pixel. The intensity is the
48     maximum value reached by any component }
49  function GetIntensity(const c: TExpandedPixel): word; inline;
50  {** Sets the intensity of a gamma-expanded pixel }
51  function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
52  {** Returns the lightness of an gamma-expanded pixel. The lightness is the
53     perceived brightness, 0 being black and 65535 being white }
54  function GetLightness(const c: TExpandedPixel): word; inline; overload;
55  {** Sets the lightness of a gamma-expanded pixel }
56  function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel; overload;
57  {** Sets the lightness of a gamma expanded pixel, provided you already know the current
58     value of lightness ''curLightness''. It is a bit faster than the previous function }
59  function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel; overload;
60  {** Returns the importance of the color. It is similar to saturation
61      in HSL colorspace, except it is gamma corrected. A value of zero indicates
62      a black/gray/white, and a value of 65535 indicates a bright color }
63  function ColorImportance(ec: TExpandedPixel): word;
64  {** Merge two gamma expanded pixels (so taking into account gamma correction) }
65  function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel; overload;
66  function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel; weight2: integer): TExpandedPixel; overload;
67  {** Computes the difference (with gamma correction) between two pixels,
68      taking into account all dimensions, including transparency. The
69      result ranges from 0 to 65535 }
70  function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
71
72  function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean=true): TExpandedPixel;
73  function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean=true): TFPColor;
74
75type
76  {* General purpose color variable with single-precision floating point values }
77  TColorF = packed array[1..4] of single;
78  ArrayOfTColorF = array of TColorF;
79
80  {** Creates a TColorF structure }
81  function ColorF(red,green,blue,alpha: single): TColorF;
82  function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF; overload;
83  function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean): ArrayOfTColorF; overload;
84  function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel;
85  function GammaCompressionF(c: TColorF): TColorF;
86  function GammaExpansionF(c: TColorF): TColorF;
87  {** Subtract each component separately }
88  operator - (const c1, c2: TColorF): TColorF; inline;
89  {** Add each component separately }
90  operator + (const c1, c2: TColorF): TColorF; inline;
91  {** Multiply each component separately }
92  operator * (const c1, c2: TColorF): TColorF; inline;
93  {** Multiply each component by ''factor'' }
94  operator * (const c1: TColorF; factor: single): TColorF; inline;
95
96type
97  {* Pixel color defined in HSL colorspace. Values range from 0 to 65535 }
98
99  { THSLAPixel }
100
101  THSLAPixel = packed record
102    {** Hue of the pixel. Extremum values 0 and 65535 are red }
103    hue: word;
104    {** Saturation of the color. 0 is gray and 65535 is the brightest color (including white) }
105    saturation: word;
106    {** Lightness of the color. 0 is black, 32768 is normal, and 65535 is white }
107    lightness: word;
108    {** Opacity of the pixel. 0 is transparent and 65535 is opaque }
109    alpha: word;
110  end;
111
112  {** Creates a pixel with given HSLA values, where A stands for alpha }
113  function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel; overload; inline;
114  {** Creates an opaque pixel with given HSL values }
115  function HSLA(hue, saturation, lightness: word): THSLAPixel; overload; inline;
116  {** Converts a pixel from sRGB to HSL color space }
117  function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
118  {** Converts a pixel from gamma expanded RGB to HSL color space }
119  function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
120  {** Converts a pixel from HSL colorspace to sRGB }
121  function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
122  {** Converts a pixel from HSL colorspace to gamma expanded RGB }
123  function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
124  {** Computes the hue difference }
125  function HueDiff(h1, h2: word): word;
126  {** Returns the hue of a gamma expanded pixel }
127  function GetHue(ec: TExpandedPixel): word;
128
129type
130  {* Pixel color defined in corrected HSL colorspace. G stands for corrected hue
131     and B stands for actual brightness. Values range from 0 to 65535 }
132  TGSBAPixel = packed record
133    {** Hue of the pixel. Extremum values 0 and 65535 are red }
134    hue: word;
135    {** Saturation of the color. 0 is gray and 65535 is the brightest color (excluding white) }
136    saturation: word;
137    {** Actual perceived brightness. 0 is black, 32768 is normal, and 65535 is white }
138    lightness: word;
139    {** Opacity of the pixel. 0 is transparent and 65535 is opaque }
140    alpha: word;
141  end;
142
143  {** Converts a pixel from sRGB to correct HSL color space }
144  function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
145  {** Converts a pixel from gamma expanded RGB to correct HSL color space }
146  function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel;
147  {** Converts a G hue (GSBA) to a H hue (HSLA) }
148  function GtoH(ghue: word): word;
149  {** Converts a H hue (HSLA) to a G hue (GSBA) }
150  function HtoG(hue: word): word;
151  {** Converts a pixel from corrected HSL to sRGB }
152  function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel; overload;
153  function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel; overload;
154  {** Converts a pixel from correct HSL to gamma expanded RGB }
155  function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel; overload;
156  function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel; overload;
157  {** Converts a pixel from correct HSL to usual HSL }
158  function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel; overload;
159  function GSBAToHSLA(const c: THSLAPixel): THSLAPixel; overload;
160  function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel;
161
162type
163  { TBGRAPixelBasicHelper }
164
165  TBGRAPixelBasicHelper = record helper for TBGRAPixel
166    function ToExpanded: TExpandedPixel;
167    procedure FromExpanded(const AValue: TExpandedPixel);
168    function ToHSLAPixel: THSLAPixel;
169    procedure FromHSLAPixel(const AValue: THSLAPixel);
170    function ToGSBAPixel: TGSBAPixel;
171    procedure FromGSBAPixel(const AValue: TGSBAPixel); overload;
172    procedure FromGSBAPixel(const AValue: THSLAPixel); overload;
173    function ToColorF(AGammaExpansion: boolean): TColorF;
174    procedure FromColorF(const AValue: TColorF; AGammaCompression: boolean);
175  end;
176
177  { TExpandedPixelBasicHelper }
178
179  TExpandedPixelBasicHelper = record helper for TExpandedPixel
180    function ToFPColor(AGammaCompression: boolean = true): TFPColor;
181    procedure FromFPColor(const AValue: TFPColor; AGammaExpansion: boolean = true);
182    function ToColor: TColor;
183    procedure FromColor(const AValue: TColor);
184    function ToBGRAPixel: TBGRAPixel;
185    procedure FromBGRAPixel(AValue: TBGRAPixel);
186    function ToHSLAPixel: THSLAPixel;
187    procedure FromHSLAPixel(const AValue: THSLAPixel);
188    function ToGSBAPixel: TGSBAPixel;
189    procedure FromGSBAPixel(const AValue: TGSBAPixel); overload;
190    procedure FromGSBAPixel(const AValue: THSLAPixel); overload;
191  end;
192
193operator := (const AValue: TExpandedPixel): TColor;
194operator := (const AValue: TColor): TExpandedPixel;
195Operator := (const Source: TExpandedPixel): TBGRAPixel;
196Operator := (const Source: TBGRAPixel): TExpandedPixel;
197
198type
199  { TFPColorBasicHelper }
200
201  TFPColorBasicHelper = record helper for TFPColor
202    function ToColor: TColor;
203    procedure FromColor(const AValue: TColor);
204    function ToBGRAPixel: TBGRAPixel;
205    procedure FromBGRAPixel(AValue: TBGRAPixel);
206    function ToExpanded(AGammaExpansion: boolean = true): TExpandedPixel;
207    procedure FromExpanded(const AValue: TExpandedPixel; AGammaCompression: boolean = true);
208    function ToHSLAPixel(AGammaExpansion: boolean = true): THSLAPixel;
209    procedure FromHSLAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true);
210    function ToGSBAPixel(AGammaExpansion: boolean = true): TGSBAPixel;
211    procedure FromGSBAPixel(const AValue: TGSBAPixel; AGammaCompression: boolean = true); overload;
212    procedure FromGSBAPixel(const AValue: THSLAPixel; AGammaCompression: boolean = true); overload;
213  end;
214
215  { THSLAPixelBasicHelper }
216
217  THSLAPixelBasicHelper = record helper for THSLAPixel
218    function ToColor: TColor;
219    procedure FromColor(const AValue: TColor);
220    function ToBGRAPixel: TBGRAPixel;
221    procedure FromBGRAPixel(AValue: TBGRAPixel);
222    function ToGSBAPixel: TGSBAPixel;
223    procedure FromGSBAPixel(AValue: TGSBAPixel);
224    function ToExpanded: TExpandedPixel;
225    procedure FromExpanded(AValue: TExpandedPixel);
226    function ToFPColor(AGammaCompression: boolean=true): TFPColor;
227    procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true);
228  end;
229
230Operator := (const Source: THSLAPixel): TBGRAPixel;
231Operator := (const Source: TBGRAPixel): THSLAPixel;
232Operator := (const Source: THSLAPixel): TExpandedPixel;
233Operator := (const Source: TExpandedPixel): THSLAPixel;
234operator := (const AValue: TColor): THSLAPixel;
235operator := (const AValue: THSLAPixel): TColor;
236
237type
238  { TGSBAPixelBasicHelper }
239
240  TGSBAPixelBasicHelper = record helper for TGSBAPixel
241    function ToColor: TColor;
242    procedure FromColor(const AValue: TColor);
243    function ToBGRAPixel: TBGRAPixel;
244    procedure FromBGRAPixel(AValue: TBGRAPixel);
245    function ToHSLAPixel: THSLAPixel;
246    procedure FromHSLAPixel(AValue: THSLAPixel);
247    function ToExpanded: TExpandedPixel;
248    procedure FromExpanded(AValue: TExpandedPixel);
249    function ToFPColor(AGammaCompression: boolean=true): TFPColor;
250    procedure FromFPColor(AValue: TFPColor; AGammaExpansion: boolean=true);
251  end;
252
253Operator := (const Source: TGSBAPixel): TBGRAPixel;
254Operator := (const Source: TBGRAPixel): TGSBAPixel;
255Operator := (const Source: TGSBAPixel): TExpandedPixel;
256Operator := (const Source: TExpandedPixel): TGSBAPixel;
257operator := (const AValue: TColor): TGSBAPixel;
258operator := (const AValue: TGSBAPixel): TColor;
259Operator := (const Source: TGSBAPixel): THSLAPixel; //no conversion, just copying for backward compatibility (use ToHSLAPixel instead for conversion)
260Operator := (const Source: THSLAPixel): TGSBAPixel; //no conversion, just copying for backward compatibility (use ToGSBAPixel instead for conversion)
261{$ENDIF}
262
263
264{$IFDEF INCLUDE_IMPLEMENTATION}
265{$UNDEF INCLUDE_IMPLEMENTATION}
266{ TBGRAPixel }
267
268function TBGRAPixel.GetClassIntensity: word;
269begin
270  result := GetIntensity(self);
271end;
272
273function TBGRAPixel.GetClassLightness: word;
274begin
275  result := GetLightness(self);
276end;
277
278procedure TBGRAPixel.SetClassIntensity(AValue: word);
279begin
280  self := SetIntensity(self, AValue);
281end;
282
283procedure TBGRAPixel.SetClassLightness(AValue: word);
284begin
285  self := SetLightness(self, AValue);
286end;
287
288procedure TBGRAPixel.FromRGB(ARed, AGreen, ABlue: Byte; AAlpha: Byte);
289begin
290  red := ARed;
291  green := AGreen;
292  blue := ABlue;
293  alpha := AAlpha;
294end;
295
296procedure TBGRAPixel.FromColor(AColor: TColor; AAlpha: Byte);
297begin
298  if AColor = clNone then
299    Self := BGRAPixelTransparent
300  else
301  begin
302    RedGreenBlue(ColorToRGB(AColor), red,green,blue);
303    alpha := AAlpha;
304  end;
305end;
306
307procedure TBGRAPixel.FromString(AStr: string);
308begin
309  Self := StrToBGRA(AStr);
310end;
311
312procedure TBGRAPixel.FromFPColor(AColor: TFPColor);
313begin
314  self := FPColorToBGRA(AColor);
315end;
316
317procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue, AAlpha: Byte);
318begin
319  ARed := red;
320  AGreen := green;
321  ABlue := blue;
322  AAlpha := alpha;
323end;
324
325procedure TBGRAPixel.ToRGB(out ARed, AGreen, ABlue: Byte);
326begin
327  ARed := red;
328  AGreen := green;
329  ABlue := blue
330end;
331
332function TBGRAPixel.ToColor: TColor;
333begin
334  if alpha = 0 then
335    result := clNone
336  else
337    result := RGBToColor(red,green,blue);
338end;
339
340function TBGRAPixel.ToString: string;
341begin
342  result := BGRAToStr(Self, CSSColors);
343end;
344
345function TBGRAPixel.ToGrayscale(AGammaCorrection: boolean): TBGRAPixel;
346begin
347  if AGammaCorrection then
348    result := BGRAToGrayscale(self)
349  else
350    result := BGRAToGrayscaleLinear(self);
351end;
352
353function TBGRAPixel.ToFPColor: TFPColor;
354begin
355  result := BGRAToFPColor(Self);
356end;
357
358function TBGRAPixel.EqualsExactly(constref AColor: TBGRAPixel): boolean;
359begin
360  result := PLongWord(@AColor)^ = PLongWord(@self)^;
361end;
362
363class operator TBGRAPixel.:=(Source: TBGRAPixel): TColor;
364begin
365  result := Source.ToColor;
366end;
367
368class operator TBGRAPixel.:=(Source: TColor): TBGRAPixel;
369begin
370  result.FromColor(Source);
371end;
372
373{ The gamma correction is approximated here by a power function }
374var
375  GammaExpFactor   : single; //exponent
376
377const
378  redWeightShl10   = 306; // = 0.299
379  greenWeightShl10 = 601; // = 0.587
380  blueWeightShl10  = 117; // = 0.114
381
382procedure BGRANoGamma;
383var i,j: integer;
384  prevExp, nextExp: Word;
385begin
386  GammaExpFactor := 1;
387  prevExp := 0;
388  for i := 0 to 255 do
389  begin
390    GammaExpansionTab[i] := (i shl 8) + i;
391    if i = 255 then nextExp := 65535
392    else
393    begin
394      nextExp := GammaExpansionTab[i]+128;
395      GammaExpansionTabHalf[i] := nextExp+1;
396    end;
397    for j := prevExp to nextExp do
398      GammaCompressionTab[j] := i;
399    if i < 255 then
400      prevExp := nextExp+1;
401  end;
402end;
403
404procedure BGRASetGamma(AGamma: single);
405var
406  GammaLinearFactor: single;
407  i,j,prevpos,nextpos,midpos: Int32or64;
408begin
409  if AGamma = 1 then
410  begin
411    BGRANoGamma;
412    exit;
413  end;
414  GammaExpFactor := AGamma;
415  //the linear factor is used to normalize expanded values in the range 0..65535
416  GammaLinearFactor := 65535 / power(255, GammaExpFactor);
417  GammaExpansionTab[0] := 0;
418  nextpos := 0;
419  for i := 0 to 255 do
420  begin
421    prevpos := nextpos;
422    midpos := round(power(i, GammaExpFactor) * GammaLinearFactor);
423    if i = 255 then
424      nextpos := 65536
425    else
426      nextpos := round(power(i+0.5, GammaExpFactor) * GammaLinearFactor);
427    GammaExpansionTab[i] := midpos;
428    if i < 255 then
429      GammaExpansionTabHalf[i] := nextpos;
430    for j := prevpos to midpos-1 do
431      GammaCompressionTab[j] := i;
432    for j := midpos to nextpos-1 do
433      GammaCompressionTab[j] := i;
434  end;
435  GammaCompressionTab[0] := 0;
436end;
437
438function BGRAGetGamma: single;
439begin
440  result := GammaExpFactor;
441end;
442
443procedure AllocateExpandedPixelBuffer(var ABuffer: TExpandedPixelBuffer;
444  ASize: integer);
445begin
446  if ASize > length(ABuffer) then
447    setlength(ABuffer, max(length(ABuffer)*2,ASize));
448end;
449
450{ Apply gamma correction using conversion tables }
451function GammaExpansion(c: TBGRAPixel): TExpandedPixel;
452begin
453  Result.red   := GammaExpansionTab[c.red];
454  Result.green := GammaExpansionTab[c.green];
455  Result.blue  := GammaExpansionTab[c.blue];
456  Result.alpha := c.alpha shl 8 + c.alpha;
457end;
458
459function GammaCompression(const ec: TExpandedPixel): TBGRAPixel;
460begin
461  Result.red   := GammaCompressionTab[ec.red];
462  Result.green := GammaCompressionTab[ec.green];
463  Result.blue  := GammaCompressionTab[ec.blue];
464  Result.alpha := ec.alpha shr 8;
465end;
466
467function GammaCompression(red, green, blue, alpha: word): TBGRAPixel;
468begin
469  Result.red   := GammaCompressionTab[red];
470  Result.green := GammaCompressionTab[green];
471  Result.blue  := GammaCompressionTab[blue];
472  Result.alpha := alpha shr 8;
473end;
474
475function GammaExpansionW(ACompressed: word): word;
476const
477  fracShift = 8;
478  fracHalf = 1 shl (fracShift-1);
479  fracQuarter = 1 shl (fracShift-2);
480var
481  intPart, fracPart, half: word;
482  byteVal: byte;
483begin
484  if ACompressed = 0 then
485    result := 0
486  else if ACompressed = $ffff then
487    result := $ffff
488  else
489  begin
490    //div 257
491    byteVal := ACompressed shr fracShift;
492    intPart := (byteVal shl fracShift) + byteVal;
493    if ACompressed < intPart then
494    begin
495      dec(byteVal);
496      dec(intPart, 257);
497    end;
498
499    fracPart := ACompressed - intPart;
500    if fracPart >= fracHalf then dec(fracPart);  //[0..256] -> [0..255]
501
502    if fracPart >= fracHalf then
503    begin
504      result := GammaExpansionTab[byteVal+1];
505      half := GammaExpansionTabHalf[byteVal];
506      dec(result, ((result-half)*((1 shl fracShift)-fracPart)+fracQuarter) shr (fracShift-1));
507    end
508    else
509    begin
510      result := GammaExpansionTab[byteVal];
511      if fracPart > 0 then
512      begin
513        half := GammaExpansionTabHalf[byteVal];
514        inc(result, ((half-result)*fracPart+fracQuarter) shr (fracShift-1));
515      end;
516    end;
517  end;
518end;
519
520function GammaCompressionW(AExpanded: word): word;
521var
522  compByte: Byte;
523  reExp, reExpDelta: Word;
524begin
525  if AExpanded=0 then exit(0) else
526  if AExpanded=65535 then exit(65535) else
527  begin
528    compByte := GammaCompressionTab[AExpanded];
529    reExp := GammaExpansionTab[compByte];
530    result := compByte + (compByte shl 8);
531    if reExp < AExpanded then
532    begin
533      reExpDelta := GammaExpansionTabHalf[compByte]-reExp;
534      if reExpDelta<>0 then
535        inc(result, ((AExpanded-reExp)*128+(reExpDelta shr 1)) div reExpDelta);
536    end else
537    begin
538      reExpDelta := reExp-GammaExpansionTabHalf[compByte-1];
539      if reExpDelta<>0 then
540        dec(result, ((reExp-AExpanded)*128+(reExpDelta shr 1)) div reExpDelta);
541    end;
542  end;
543end;
544
545{ The intensity is defined here as the maximum value of any color component }
546function GetIntensity(const c: TExpandedPixel): word; inline;
547begin
548  Result := c.red;
549  if c.green > Result then
550    Result := c.green;
551  if c.blue > Result then
552    Result := c.blue;
553end;
554
555function SetIntensity(const c: TExpandedPixel; intensity: word): TExpandedPixel;
556var
557  curIntensity: word;
558begin
559  curIntensity := GetIntensity(c);
560  if curIntensity = 0 then //suppose it's gray if there is no color information
561  begin
562    Result.red := intensity;
563    Result.green := intensity;
564    Result.blue := intensity;
565    result.alpha := c.alpha;
566  end
567  else
568  begin
569    //linear interpolation to reached wanted intensity
570    Result.red   := (c.red * intensity + (curIntensity shr 1)) div curIntensity;
571    Result.green := (c.green * intensity + (curIntensity shr 1)) div curIntensity;
572    Result.blue  := (c.blue * intensity + (curIntensity shr 1)) div curIntensity;
573    Result.alpha := c.alpha;
574  end;
575end;
576
577{ The lightness here is defined as the subjective sensation of luminosity, where
578  blue is the darkest component and green the lightest }
579function GetLightness(const c: TExpandedPixel): word; inline;
580begin
581  Result := (c.red * redWeightShl10 + c.green * greenWeightShl10 +
582    c.blue * blueWeightShl10 + 512) shr 10;
583end;
584
585function SetLightness(const c: TExpandedPixel; lightness: word): TExpandedPixel;
586var
587  curLightness: word;
588begin
589  curLightness := GetLightness(c);
590  if lightness = curLightness then
591  begin //no change
592    Result := c;
593    exit;
594  end;
595  result := SetLightness(c, lightness, curLightness);
596end;
597
598function SetLightness(const c: TExpandedPixel; lightness: word; curLightness: word): TExpandedPixel;
599var
600  AddedWhiteness, maxBeforeWhite: word;
601  clip: boolean;
602begin
603  if lightness = curLightness then
604  begin //no change
605    Result := c;
606    exit;
607  end;
608  if lightness = 65535 then //set to white
609  begin
610    Result.red   := 65535;
611    Result.green := 65535;
612    Result.blue  := 65535;
613    Result.alpha := c.alpha;
614    exit;
615  end;
616  if lightness = 0 then  //set to black
617  begin
618    Result.red   := 0;
619    Result.green := 0;
620    Result.blue  := 0;
621    Result.alpha := c.alpha;
622    exit;
623  end;
624  if curLightness = 0 then  //set from black
625  begin
626    Result.red   := lightness;
627    Result.green := lightness;
628    Result.blue  := lightness;
629    Result.alpha := c.alpha;
630    exit;
631  end;
632  if lightness < curLightness then //darker is easy
633  begin
634    result.alpha:= c.alpha;
635    result.red := (c.red * lightness + (curLightness shr 1)) div curLightness;
636    result.green := (c.green * lightness + (curLightness shr 1)) div curLightness;
637    result.blue := (c.blue * lightness + (curLightness shr 1)) div curLightness;
638    exit;
639  end;
640  //lighter and grayer
641  Result := c;
642  AddedWhiteness := lightness - curLightness;
643  maxBeforeWhite := 65535 - AddedWhiteness;
644  clip   := False;
645  if Result.red <= maxBeforeWhite then
646    Inc(Result.red, AddedWhiteness)
647  else
648  begin
649    Result.red := 65535;
650    clip := True;
651  end;
652  if Result.green <= maxBeforeWhite then
653    Inc(Result.green, AddedWhiteness)
654  else
655  begin
656    Result.green := 65535;
657    clip := True;
658  end;
659  if Result.blue <= maxBeforeWhite then
660    Inc(Result.blue, AddedWhiteness)
661  else
662  begin
663    Result.blue := 65535;
664    clip := True;
665  end;
666
667  if clip then //light and whiter
668  begin
669    curLightness   := GetLightness(Result);
670    addedWhiteness := lightness - curLightness;
671    maxBeforeWhite := 65535 - curlightness;
672    Result.red     := Result.red + addedWhiteness * (65535 - Result.red) div
673      maxBeforeWhite;
674    Result.green   := Result.green + addedWhiteness * (65535 - Result.green) div
675      maxBeforeWhite;
676    Result.blue    := Result.blue + addedWhiteness * (65535 - Result.blue) div
677      maxBeforeWhite;
678  end;
679end;
680
681function ColorImportance(ec: TExpandedPixel): word;
682var min,max: word;
683begin
684  min := ec.red;
685  max := ec.red;
686  if ec.green > max then
687    max := ec.green
688  else
689  if ec.green < min then
690    min := ec.green;
691  if ec.blue > max then
692    max := ec.blue
693  else
694  if ec.blue < min then
695    min  := ec.blue;
696  result := max - min;
697end;
698
699{ Merge two colors of same importance }
700function MergeBGRA(ec1, ec2: TExpandedPixel): TExpandedPixel;
701var c12: LongWord;
702begin
703  if (ec1.alpha = 0) then
704    Result := ec2
705  else
706  if (ec2.alpha = 0) then
707    Result := ec1
708  else
709  begin
710    c12 := ec1.alpha + ec2.alpha;
711    Result.red   := (int64(ec1.red) * ec1.alpha + int64(ec2.red) * ec2.alpha + c12 shr 1) div c12;
712    Result.green := (int64(ec1.green) * ec1.alpha + int64(ec2.green) * ec2.alpha + c12 shr 1) div c12;
713    Result.blue  := (int64(ec1.blue) * ec1.alpha + int64(ec2.blue) * ec2.alpha + c12 shr 1) div c12;
714    Result.alpha := (c12 + 1) shr 1;
715  end;
716end;
717
718function MergeBGRA(ec1: TExpandedPixel; weight1: integer; ec2: TExpandedPixel;
719  weight2: integer): TExpandedPixel;
720var
721    f1,f2,f12: int64;
722begin
723  if (weight1 = 0) then
724  begin
725    if (weight2 = 0) then
726      result := BGRAPixelTransparent
727    else
728      Result := ec2
729  end
730  else
731  if (weight2 = 0) then
732    Result := ec1
733  else
734  if (weight1+weight2 = 0) then
735    Result := BGRAPixelTransparent
736  else
737  begin
738    f1 := int64(ec1.alpha)*weight1;
739    f2 := int64(ec2.alpha)*weight2;
740    f12 := f1+f2;
741    if f12 = 0 then
742      result := BGRAPixelTransparent
743    else
744    begin
745      Result.red   := (ec1.red * f1 + ec2.red * f2 + f12 shr 1) div f12;
746      Result.green := (ec1.green * f1 + ec2.green * f2 + f12 shr 1) div f12;
747      Result.blue  := (ec1.blue * f1 + ec2.blue * f2 + f12 shr 1) div f12;
748      {$hints off}
749      Result.alpha := (f12 + ((weight1+weight2) shr 1)) div (weight1+weight2);
750      {$hints on}
751    end;
752  end;
753end;
754
755function LessStartSlope65535(value: word): word;
756var factor: word;
757begin
758  factor := 4096 - (not value)*3 shr 7;
759  result := value*factor shr 12;
760end;
761
762function ExpandedDiff(ec1, ec2: TExpandedPixel): word;
763var
764  CompRedAlpha1, CompGreenAlpha1, CompBlueAlpha1, CompRedAlpha2,
765  CompGreenAlpha2, CompBlueAlpha2: integer;
766  DiffAlpha: word;
767  ColorDiff: word;
768  TempHueDiff: word;
769begin
770  if (ec1.alpha = 0) and (ec2.alpha = 0) then exit(0) else
771  if (ec1.alpha = ec2.alpha) and (ec1.red = ec2.red) and
772     (ec1.green = ec2.green) and (ec1.blue = ec2.blue) then exit(0);
773  CompRedAlpha1 := ec1.red * ec1.alpha shr 16; //gives 0..65535
774  CompGreenAlpha1 := ec1.green * ec1.alpha shr 16;
775  CompBlueAlpha1 := ec1.blue * ec1.alpha shr 16;
776  CompRedAlpha2 := ec2.red * ec2.alpha shr 16;
777  CompGreenAlpha2 := ec2.green * ec2.alpha shr 16;
778  CompBlueAlpha2 := ec2.blue * ec2.alpha shr 16;
779  Result    := (Abs(CompRedAlpha2 - CompRedAlpha1)*redWeightShl10 +
780    Abs(CompBlueAlpha2 - CompBlueAlpha1)*blueWeightShl10 +
781    Abs(CompGreenAlpha2 - CompGreenAlpha1)*greenWeightShl10) shr 10;
782  ColorDiff := min(ColorImportance(ec1),ColorImportance(ec2));
783  if ColorDiff > 0 then
784  begin
785    TempHueDiff := HueDiff(HtoG(GetHue(ec1)),HtoG(GetHue(ec2)));
786    if TempHueDiff < 32768 then
787      TempHueDiff := LessStartSlope65535(TempHueDiff shl 1) shr 4
788    else
789      TempHueDiff := TempHueDiff shr 3;
790    Result := ((Result shr 4)* (not ColorDiff) + TempHueDiff*ColorDiff) shr 12;
791  end;
792  DiffAlpha := Abs(integer(ec2.Alpha) - integer(ec1.Alpha));
793  if DiffAlpha > Result then
794    Result := DiffAlpha;
795end;
796
797function FPColorToExpanded(AColor: TFPColor; AGammaExpansion: boolean): TExpandedPixel;
798begin
799  result.FromFPColor(AColor, AGammaExpansion);
800end;
801
802function ExpandedToFPColor(AExpanded: TExpandedPixel; AGammaCompression: boolean): TFPColor;
803begin
804  result.FromExpanded(AExpanded, AGammaCompression);
805end;
806
807function ColorF(red, green, blue, alpha: single): TColorF;
808begin
809  result[1] := red;
810  result[2] := green;
811  result[3] := blue;
812  result[4] := alpha;
813end;
814
815function BGRAToColorF(c: TBGRAPixel; AGammaExpansion: boolean): TColorF;
816const OneOver255 = 1/255;
817      OneOver65535 = 1/65535;
818begin
819  if not AGammaExpansion then
820  begin
821    result[1] := c.red*OneOver255;
822    result[2] := c.green*OneOver255;
823    result[3] := c.blue*OneOver255;
824    result[4] := c.alpha*OneOver255;
825  end else
826  with GammaExpansion(c) do
827  begin
828    result[1] := red*OneOver65535;
829    result[2] := green*OneOver65535;
830    result[3] := blue*OneOver65535;
831    result[4] := alpha*OneOver65535;
832  end;
833end;
834
835function BGRAToColorF(const a: array of TBGRAPixel; AGammaExpansion: boolean
836  ): ArrayOfTColorF;
837var
838  i: Int32or64;
839begin
840  setlength(result, length(a));
841  for i := 0 to high(a) do
842    result[i] := BGRAToColorF(a[i],AGammaExpansion);
843end;
844
845function ColorFToBGRA(c: TColorF; AGammaCompression: boolean): TBGRAPixel;
846begin
847  if not AGammaCompression then
848  begin
849    result.red := Min(255,Max(0,round(c[1]*255)));
850    result.green := Min(255,Max(0,round(c[2]*255)));
851    result.blue := Min(255,Max(0,round(c[3]*255)));
852  end else
853  begin
854    result.red := GammaCompressionTab[Min(65535,Max(0,round(c[1]*65535)))];
855    result.green := GammaCompressionTab[Min(65535,Max(0,round(c[2]*65535)))];
856    result.blue := GammaCompressionTab[Min(65535,Max(0,round(c[3]*65535)))];
857  end;
858  result.alpha := Min(255,Max(0,round(c[4]*255)));
859end;
860
861function GammaCompressionF(c: TColorF): TColorF;
862var inv: single;
863begin
864  inv := 1/GammaExpFactor;
865  result := ColorF(power(c[1],inv),power(c[2],inv),power(c[3],inv),c[4]);
866end;
867
868function GammaExpansionF(c: TColorF): TColorF;
869begin
870  result := ColorF(power(c[1],GammaExpFactor),power(c[2],GammaExpFactor),power(c[3],GammaExpFactor),c[4]);
871end;
872
873operator-(const c1, c2: TColorF): TColorF;
874begin
875  result[1] := c1[1]-c2[1];
876  result[2] := c1[2]-c2[2];
877  result[3] := c1[3]-c2[3];
878  result[4] := c1[4]-c2[4];
879end;
880
881operator+(const c1, c2: TColorF): TColorF;
882begin
883  result[1] := c1[1]+c2[1];
884  result[2] := c1[2]+c2[2];
885  result[3] := c1[3]+c2[3];
886  result[4] := c1[4]+c2[4];
887end;
888
889operator*(const c1, c2: TColorF): TColorF;
890begin
891  result[1] := c1[1]*c2[1];
892  result[2] := c1[2]*c2[2];
893  result[3] := c1[3]*c2[3];
894  result[4] := c1[4]*c2[4];
895end;
896
897operator*(const c1: TColorF; factor: single): TColorF;
898begin
899  result[1] := c1[1]*factor;
900  result[2] := c1[2]*factor;
901  result[3] := c1[3]*factor;
902  result[4] := c1[4]*factor;
903end;
904
905{ THSLAPixel }
906
907function HSLA(hue, saturation, lightness, alpha: word): THSLAPixel;
908begin
909  Result.hue   := hue;
910  Result.saturation := saturation;
911  Result.lightness  := lightness;
912  Result.alpha := alpha;
913end;
914
915function HSLA(hue, saturation, lightness: word): THSLAPixel;
916begin
917  Result.hue   := hue;
918  Result.saturation := saturation;
919  Result.lightness  := lightness;
920  Result.alpha := $ffff;
921end;
922
923{ Conversion from RGB value to HSL colorspace. See : http://en.wikipedia.org/wiki/HSL_color_space }
924function BGRAToHSLA(c: TBGRAPixel): THSLAPixel;
925begin
926  result := ExpandedToHSLA(GammaExpansion(c));
927end;
928
929procedure ExpandedToHSLAInline(r,g,b: Int32Or64; var dest: THSLAPixel); inline;
930const
931  deg60  = 10922;
932  deg120 = 21845;
933  deg240 = 43690;
934var
935  min, max, minMax: Int32or64;
936  UMinMax,UTwiceLightness: UInt32or64;
937begin
938  if g > r then
939  begin
940    max := g;
941    min := r;
942  end else
943  begin
944    max := r;
945    min := g;
946  end;
947  if b > max then
948    max := b else
949  if b < min then
950    min := b;
951  minMax := max - min;
952
953  if minMax = 0 then
954    dest.hue := 0
955  else
956  if max = r then
957    {$PUSH}{$RANGECHECKS OFF}
958    dest.hue := ((g - b) * deg60) div minMax
959    {$POP}
960  else
961  if max = g then
962    dest.hue := ((b - r) * deg60) div minMax + deg120
963  else
964    {max = b} dest.hue := ((r - g) * deg60) div minMax + deg240;
965  UTwiceLightness := max + min;
966  if min = max then
967    dest.saturation := 0 else
968  begin
969    UMinMax:= minMax;
970    if UTwiceLightness < 65536 then
971      dest.saturation := (UMinMax shl 16) div (UTwiceLightness + 1)
972    else
973      dest.saturation := (UMinMax shl 16) div (131072 - UTwiceLightness);
974  end;
975  dest.lightness := UTwiceLightness shr 1;
976end;
977
978function ExpandedToHSLA(const ec: TExpandedPixel): THSLAPixel;
979begin
980  result.alpha := ec.alpha;
981  ExpandedToHSLAInline(ec.red,ec.green,ec.blue,result);
982end;
983
984{ Conversion from HSL colorspace to RGB. See : http://en.wikipedia.org/wiki/HSL_color_space }
985function HSLAToBGRA(const c: THSLAPixel): TBGRAPixel;
986var ec: TExpandedPixel;
987begin
988  ec := HSLAToExpanded(c);
989  Result := GammaCompression(ec);
990end;
991
992function HSLAToExpanded(const c: THSLAPixel): TExpandedPixel;
993const
994  deg30  = 4096;
995  deg60  = 8192;
996  deg120 = deg60 * 2;
997  deg180 = deg60 * 3;
998  deg240 = deg60 * 4;
999  deg360 = deg60 * 6;
1000
1001  function ComputeColor(p, q: Int32or64; h: Int32or64): Int32or64; inline;
1002  begin
1003    if h < deg180 then
1004    begin
1005      if h < deg60 then
1006        Result := p + ((q - p) * h + deg30) div deg60
1007      else
1008        Result := q
1009    end else
1010    begin
1011      if h < deg240 then
1012        Result := p + ((q - p) * (deg240 - h) + deg30) div deg60
1013      else
1014        Result := p;
1015    end;
1016  end;
1017
1018var
1019  q, p, L, S, H: Int32or64;
1020begin
1021  L := c.lightness;
1022  S := c.saturation;
1023  if S = 0 then  //gray
1024  begin
1025    result.red   := L;
1026    result.green := L;
1027    result.blue  := L;
1028    result.alpha := c.alpha;
1029    exit;
1030  end;
1031  {$hints off}
1032  if L < 32768 then
1033    q := (L shr 1) * ((65535 + S) shr 1) shr 14
1034  else
1035    q := L + S - ((L shr 1) *
1036      (S shr 1) shr 14);
1037  {$hints on}
1038  if q > 65535 then q := 65535;
1039  p   := (L shl 1) - q;
1040  if p > 65535 then p := 65535;
1041  H := c.hue * deg360 shr 16;
1042  result.green := ComputeColor(p, q, H);
1043  inc(H, deg120);
1044  if H > deg360 then Dec(H, deg360);
1045  result.red   := ComputeColor(p, q, H);
1046  inc(H, deg120);
1047  if H > deg360 then Dec(H, deg360);
1048  result.blue  := ComputeColor(p, q, H);
1049  result.alpha := c.alpha;
1050end;
1051
1052function HueDiff(h1, h2: word): word;
1053begin
1054  result := abs(integer(h1)-integer(h2));
1055  if result > 32768 then result := 65536-result;
1056end;
1057
1058function GetHue(ec: TExpandedPixel): word;
1059const
1060  deg60  = 8192;
1061  deg120 = deg60 * 2;
1062  deg240 = deg60 * 4;
1063  deg360 = deg60 * 6;
1064var
1065  min, max, minMax: integer;
1066  r,g,b: integer;
1067begin
1068  r := ec.red;
1069  g := ec.green;
1070  b := ec.blue;
1071  min := r;
1072  max := r;
1073  if g > max then
1074    max := g
1075  else
1076  if g < min then
1077    min := g;
1078  if b > max then
1079    max := b
1080  else
1081  if b < min then
1082    min  := b;
1083  minMax := max - min;
1084
1085  if minMax = 0 then
1086    Result := 0
1087  else
1088  if max = r then
1089    Result := (((g - b) * deg60) div
1090      minMax + deg360) mod deg360
1091  else
1092  if max = g then
1093    Result := ((b - r) * deg60) div minMax + deg120
1094  else
1095    {max = b} Result :=
1096      ((r - g) * deg60) div minMax + deg240;
1097
1098  Result   := (Result shl 16) div deg360; //normalize
1099end;
1100
1101{ TGSBAPixel }
1102
1103function BGRAToGSBA(c: TBGRAPixel): TGSBAPixel;
1104var
1105  ec: TExpandedPixel;
1106begin
1107  ec := GammaExpansion(c);
1108  result := ExpandedToGSBA(ec);
1109end;
1110
1111function ExpandedToGSBA(const ec: TExpandedPixel): TGSBAPixel;
1112var lightness: UInt32Or64;
1113    red,green,blue: Int32or64;
1114    hsla: THSLAPixel;
1115begin
1116  red   := ec.red;
1117  green := ec.green;
1118  blue  := ec.blue;
1119  hsla.alpha := ec.alpha;
1120
1121  lightness := (red * redWeightShl10 + green * greenWeightShl10 +
1122    blue * blueWeightShl10 + 512) shr 10;
1123
1124  ExpandedToHSLAInline(red,green,blue,hsla);
1125  result := TGSBAPixel(hsla);
1126
1127  if result.lightness > 32768 then
1128    result.saturation := result.saturation* UInt32or64(not result.lightness) div 32767;
1129  result.lightness := lightness;
1130  result.hue := HtoG(result.hue);
1131end;
1132
1133function GtoH(ghue: word): word;
1134const
1135  segment: array[0..5] of UInt32or64 =
1136     (13653, 10923, 8192, 13653, 10923, 8192);
1137var g: UInt32or64;
1138begin
1139  g := ghue;
1140  if g < segment[0] then
1141    result := g * 10923 div segment[0]
1142  else
1143  begin
1144    dec(g, segment[0]);
1145    if g < segment[1] then
1146      result := g * (21845-10923) div segment[1] + 10923
1147    else
1148    begin
1149      dec(g, segment[1]);
1150      if g < segment[2] then
1151        result := g * (32768-21845) div segment[2] + 21845
1152      else
1153      begin
1154        dec(g, segment[2]);
1155        if g < segment[3] then
1156          result := g * (43691-32768) div segment[3] + 32768
1157        else
1158        begin
1159          dec(g, segment[3]);
1160          if g < segment[4] then
1161            result := g * (54613-43691) div segment[4] + 43691
1162          else
1163          begin
1164            dec(g, segment[4]);
1165            result := g * (65536-54613) div segment[5] + 54613;
1166          end;
1167        end;
1168      end;
1169    end;
1170  end;
1171end;
1172
1173function HtoG(hue: word): word;
1174const
1175  segmentDest: array[0..5] of UInt32or64 =
1176     (13653, 10923, 8192, 13653, 10923, 8192);
1177  segmentSrc: array[0..5] of UInt32or64 =
1178     (10923, 10922, 10923, 10923, 10922, 10923);
1179var
1180  h,g: UInt32or64;
1181begin
1182  h := hue;
1183  if h < segmentSrc[0] then
1184    g := h * segmentDest[0] div segmentSrc[0]
1185  else
1186  begin
1187    g := segmentDest[0];
1188    dec(h, segmentSrc[0]);
1189    if h < segmentSrc[1] then
1190      inc(g, h * segmentDest[1] div segmentSrc[1])
1191    else
1192    begin
1193      inc(g, segmentDest[1]);
1194      dec(h, segmentSrc[1]);
1195      if h < segmentSrc[2] then
1196        inc(g, h * segmentDest[2] div segmentSrc[2])
1197      else
1198      begin
1199        inc(g, segmentDest[2]);
1200        dec(h, segmentSrc[2]);
1201        if h < segmentSrc[3] then
1202          inc(g, h * segmentDest[3] div segmentSrc[3])
1203        else
1204        begin
1205          inc(g, segmentDest[3]);
1206          dec(h, segmentSrc[3]);
1207          if h < segmentSrc[4] then
1208            inc(g, h * segmentDest[4] div segmentSrc[4])
1209          else
1210          begin
1211            inc(g, segmentDest[4]);
1212            dec(h, segmentSrc[4]);
1213            inc(g, h * segmentDest[5] div segmentSrc[5]);
1214          end;
1215        end;
1216      end;
1217    end;
1218  end;
1219  result := g;
1220end;
1221
1222function GSBAToBGRA(c: TGSBAPixel): TBGRAPixel;
1223var ec: TExpandedPixel;
1224begin
1225  ec := GSBAToExpanded(c);
1226  result := GammaCompression(ec);
1227end;
1228
1229function GSBAToBGRA(const c: THSLAPixel): TBGRAPixel;
1230begin
1231  result := GSBAToBGRA(TGSBAPixel(c));
1232end;
1233
1234function GSBAToExpanded(c: TGSBAPixel): TExpandedPixel;
1235var lightness: word;
1236begin
1237  c.hue := GtoH(c.hue);
1238  lightness := c.lightness;
1239  c.lightness := 32768;
1240  result := SetLightness(HSLAToExpanded(THSLAPixel(c)),lightness);
1241end;
1242
1243function GSBAToExpanded(const c: THSLAPixel): TExpandedPixel;
1244begin
1245  result := GSBAToExpanded(TGSBAPixel(c));
1246end;
1247
1248function GSBAToHSLA(const c: TGSBAPixel): THSLAPixel;
1249begin
1250  result := ExpandedToHSLA(GSBAToExpanded(c));
1251end;
1252
1253function GSBAToHSLA(const c: THSLAPixel): THSLAPixel;
1254begin
1255  result := ExpandedToHSLA(GSBAToExpanded(TGSBAPixel(c)));
1256end;
1257
1258function HSLAToGSBA(const c: THSLAPixel): TGSBAPixel;
1259begin
1260  result := ExpandedToGSBA(HSLAToExpanded(c));
1261end;
1262
1263{ TBGRAPixelBasicHelper }
1264
1265function TBGRAPixelBasicHelper.ToExpanded: TExpandedPixel;
1266begin
1267  result := GammaExpansion(self);
1268end;
1269
1270procedure TBGRAPixelBasicHelper.FromExpanded(const AValue: TExpandedPixel);
1271begin
1272  Self := GammaCompression(AValue);
1273end;
1274
1275function TBGRAPixelBasicHelper.ToHSLAPixel: THSLAPixel;
1276begin
1277  result := BGRAToHSLA(Self);
1278end;
1279
1280procedure TBGRAPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel);
1281begin
1282  Self := HSLAToBGRA(AValue);
1283end;
1284
1285function TBGRAPixelBasicHelper.ToGSBAPixel: TGSBAPixel;
1286begin
1287  result := BGRAToGSBA(Self);
1288end;
1289
1290procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel);
1291begin
1292  Self := GSBAToBGRA(AValue);
1293end;
1294
1295procedure TBGRAPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel);
1296begin
1297  Self := GSBAToBGRA(AValue);
1298end;
1299
1300function TBGRAPixelBasicHelper.ToColorF(AGammaExpansion: boolean): TColorF;
1301begin
1302  result := BGRAToColorF(Self,AGammaExpansion);
1303end;
1304
1305procedure TBGRAPixelBasicHelper.FromColorF(const AValue: TColorF;
1306    AGammaCompression: boolean);
1307begin
1308  Self := ColorFToBGRA(AValue,AGammaCompression);
1309end;
1310
1311{ TExpandedPixelBasicHelper }
1312
1313function TExpandedPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor;
1314begin
1315  if AGammaCompression then
1316  begin
1317    result.red := GammaCompressionW(self.red);
1318    result.green := GammaCompressionW(self.green);
1319    result.blue := GammaCompressionW(self.blue);
1320  end else
1321  begin
1322    result.red := self.red;
1323    result.green := self.green;
1324    result.blue := self.blue;
1325  end;
1326  result.alpha := self.alpha;
1327end;
1328
1329procedure TExpandedPixelBasicHelper.FromFPColor(const AValue: TFPColor;
1330  AGammaExpansion: boolean);
1331begin
1332  if AGammaExpansion then
1333  begin
1334    self.red := GammaExpansionW(AValue.red);
1335    self.green := GammaExpansionW(AValue.green);
1336    self.blue := GammaExpansionW(AValue.blue);
1337  end else
1338  begin
1339    self.red := AValue.red;
1340    self.green := AValue.green;
1341    self.blue := AValue.blue;
1342  end;
1343  self.alpha := AValue.alpha;
1344end;
1345
1346function TExpandedPixelBasicHelper.ToColor: TColor;
1347begin
1348  result := BGRAToColor(GammaCompression(self));
1349end;
1350
1351procedure TExpandedPixelBasicHelper.FromColor(const AValue: TColor);
1352begin
1353  self := GammaExpansion(ColorToBGRA(AValue));
1354end;
1355
1356function TExpandedPixelBasicHelper.ToBGRAPixel: TBGRAPixel;
1357begin
1358  result := GammaCompression(Self);
1359end;
1360
1361procedure TExpandedPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel);
1362begin
1363  Self := GammaExpansion(AValue);
1364end;
1365
1366function TExpandedPixelBasicHelper.ToHSLAPixel: THSLAPixel;
1367begin
1368  result := ExpandedToHSLA(Self);
1369end;
1370
1371procedure TExpandedPixelBasicHelper.FromHSLAPixel(const AValue: THSLAPixel);
1372begin
1373  Self := HSLAToExpanded(AValue);
1374end;
1375
1376function TExpandedPixelBasicHelper.ToGSBAPixel: TGSBAPixel;
1377begin
1378  result := ExpandedToGSBA(Self);
1379end;
1380
1381procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel);
1382begin
1383  Self := GSBAToExpanded(AValue);
1384end;
1385
1386procedure TExpandedPixelBasicHelper.FromGSBAPixel(const AValue: THSLAPixel);
1387begin
1388  Self := GSBAToExpanded(AValue);
1389end;
1390
1391operator := (const AValue: TExpandedPixel): TColor;
1392begin Result := BGRAToColor(GammaCompression(AValue)); end;
1393
1394operator := (const AValue: TColor): TExpandedPixel;
1395begin Result := GammaExpansion(ColorToBGRA(AValue)) end;
1396
1397operator :=(const Source: TExpandedPixel): TBGRAPixel;
1398begin
1399  result := GammaCompression(Source);
1400end;
1401
1402operator :=(const Source: TBGRAPixel): TExpandedPixel;
1403begin
1404  result := GammaExpansion(Source);
1405end;
1406
1407{ TFPColorBasicHelper }
1408
1409function TFPColorBasicHelper.ToColor: TColor;
1410begin
1411  result := FPColorToTColor(self);
1412end;
1413
1414procedure TFPColorBasicHelper.FromColor(const AValue: TColor);
1415begin
1416  self := TColorToFPColor(AValue);
1417end;
1418
1419function TFPColorBasicHelper.ToBGRAPixel: TBGRAPixel;
1420begin
1421  result := FPColorToBGRA(self);
1422end;
1423
1424procedure TFPColorBasicHelper.FromBGRAPixel(AValue: TBGRAPixel);
1425begin
1426  self := BGRAToFPColor(AValue);
1427end;
1428
1429function TFPColorBasicHelper.ToExpanded(AGammaExpansion: boolean): TExpandedPixel;
1430begin
1431  result.FromFPColor(self, AGammaExpansion);
1432end;
1433
1434procedure TFPColorBasicHelper.FromExpanded(const AValue: TExpandedPixel;
1435  AGammaCompression: boolean);
1436begin
1437  self := AValue.ToFPColor(AGammaCompression);
1438end;
1439
1440function TFPColorBasicHelper.ToHSLAPixel(AGammaExpansion: boolean): THSLAPixel;
1441begin
1442  result.FromFPColor(self, AGammaExpansion);
1443end;
1444
1445procedure TFPColorBasicHelper.FromHSLAPixel(const AValue: THSLAPixel;
1446  AGammaCompression: boolean);
1447begin
1448  FromExpanded(AValue.ToExpanded, AGammaCompression);
1449end;
1450
1451function TFPColorBasicHelper.ToGSBAPixel(AGammaExpansion: boolean): TGSBAPixel;
1452begin
1453  result.FromFPColor(self, AGammaExpansion);
1454end;
1455
1456procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: TGSBAPixel;
1457  AGammaCompression: boolean);
1458begin
1459  FromExpanded(AValue.ToExpanded, AGammaCompression);
1460end;
1461
1462procedure TFPColorBasicHelper.FromGSBAPixel(const AValue: THSLAPixel;
1463  AGammaCompression: boolean);
1464begin
1465  FromExpanded(AValue.ToExpanded, AGammaCompression);
1466end;
1467
1468{ THSLAPixelBasicHelper }
1469
1470function THSLAPixelBasicHelper.ToColor: TColor;
1471begin
1472  result := BGRAToColor(HSLAToBGRA(self));
1473end;
1474
1475procedure THSLAPixelBasicHelper.FromColor(const AValue: TColor);
1476begin
1477  self := BGRAToHSLA(ColorToBGRA(AValue));
1478end;
1479
1480function THSLAPixelBasicHelper.ToBGRAPixel: TBGRAPixel;
1481begin
1482  result := HSLAToBGRA(self);
1483end;
1484
1485procedure THSLAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel);
1486begin
1487  self := BGRAToHSLA(AValue);
1488end;
1489
1490function THSLAPixelBasicHelper.ToGSBAPixel: TGSBAPixel;
1491begin
1492  result := HSLAToGSBA(self);
1493end;
1494
1495procedure THSLAPixelBasicHelper.FromGSBAPixel(AValue: TGSBAPixel);
1496begin
1497  self := GSBAToHSLA(AValue);
1498end;
1499
1500function THSLAPixelBasicHelper.ToExpanded: TExpandedPixel;
1501begin
1502  result := HSLAToExpanded(Self);
1503end;
1504
1505procedure THSLAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel);
1506begin
1507  Self := ExpandedToHSLA(AValue);
1508end;
1509
1510function THSLAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor;
1511begin
1512  result.FromExpanded(self.ToExpanded, AGammaCompression);
1513end;
1514
1515procedure THSLAPixelBasicHelper.FromFPColor(AValue: TFPColor;
1516  AGammaExpansion: boolean);
1517begin
1518  FromExpanded(AValue.ToExpanded(AGammaExpansion));
1519end;
1520
1521operator :=(const Source: THSLAPixel): TBGRAPixel;
1522begin
1523  result := HSLAToBGRA(Source);
1524end;
1525
1526operator :=(const Source: TBGRAPixel): THSLAPixel;
1527begin
1528  result := BGRAToHSLA(Source);
1529end;
1530
1531operator :=(const Source: THSLAPixel): TExpandedPixel;
1532begin
1533  result := HSLAToExpanded(Source);
1534end;
1535
1536operator:=(const Source: TExpandedPixel): THSLAPixel;
1537begin
1538  result := ExpandedToHSLA(Source);
1539end;
1540
1541operator := (const AValue: TColor): THSLAPixel;
1542begin Result := BGRAToHSLA(ColorToBGRA(AValue)) end;
1543
1544operator := (const AValue: THSLAPixel): TColor;
1545begin Result := BGRAToColor(HSLAToBGRA(AValue)) end;
1546
1547{ TGSBAPixelBasicHelper }
1548
1549function TGSBAPixelBasicHelper.ToColor: TColor;
1550begin
1551  result := BGRAToColor(GSBAToBGRA(self));
1552end;
1553
1554procedure TGSBAPixelBasicHelper.FromColor(const AValue: TColor);
1555begin
1556  self := BGRAToGSBA(ColorToBGRA(AValue));
1557end;
1558
1559function TGSBAPixelBasicHelper.ToBGRAPixel: TBGRAPixel;
1560begin
1561  result := GSBAToBGRA(self);
1562end;
1563
1564procedure TGSBAPixelBasicHelper.FromBGRAPixel(AValue: TBGRAPixel);
1565begin
1566  self := BGRAToGSBA(AValue);
1567end;
1568
1569function TGSBAPixelBasicHelper.ToHSLAPixel: THSLAPixel;
1570begin
1571  result := GSBAToHSLA(self);
1572end;
1573
1574procedure TGSBAPixelBasicHelper.FromHSLAPixel(AValue: THSLAPixel);
1575begin
1576  self := HSLAToGSBA(AValue);
1577end;
1578
1579function TGSBAPixelBasicHelper.ToExpanded: TExpandedPixel;
1580begin
1581  result := GSBAToExpanded(self);
1582end;
1583
1584procedure TGSBAPixelBasicHelper.FromExpanded(AValue: TExpandedPixel);
1585begin
1586  self := ExpandedToGSBA(AValue);
1587end;
1588
1589function TGSBAPixelBasicHelper.ToFPColor(AGammaCompression: boolean): TFPColor;
1590begin
1591  result.FromGSBAPixel(self, AGammaCompression);
1592end;
1593
1594procedure TGSBAPixelBasicHelper.FromFPColor(AValue: TFPColor;
1595  AGammaExpansion: boolean);
1596begin
1597  FromExpanded(AValue.ToExpanded(AGammaExpansion));
1598end;
1599
1600operator :=(const Source: TGSBAPixel): TBGRAPixel;
1601begin
1602  result := GSBAToBGRA(Source);
1603end;
1604
1605operator :=(const Source: TBGRAPixel): TGSBAPixel;
1606begin
1607  result := BGRAToGSBA(Source);
1608end;
1609
1610operator :=(const Source: TGSBAPixel): TExpandedPixel;
1611begin
1612  result := GSBAToExpanded(Source);
1613end;
1614
1615operator:=(const Source: TExpandedPixel): TGSBAPixel;
1616begin
1617  result := ExpandedToGSBA(Source);
1618end;
1619
1620operator := (const AValue: TColor): TGSBAPixel;
1621begin Result := BGRAToGSBA(ColorToBGRA(AValue)) end;
1622
1623operator := (const AValue: TGSBAPixel): TColor;
1624begin Result := BGRAToColor(GSBAToBGRA(AValue)) end;
1625
1626operator :=(const Source: TGSBAPixel): THSLAPixel;
1627begin
1628  result := THSLAPixel(Pointer(@Source)^);
1629end;
1630
1631operator:=(const Source: THSLAPixel): TGSBAPixel;
1632begin
1633  result := TGSBAPixel(Pointer(@Source)^);
1634end;
1635{$ENDIF}
1636