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