1 unit BGRAColorEx;
2
3 {$mode objfpc}{$H+}
4 {$MODESWITCH ADVANCEDRECORDS}
5
6 interface
7
8 uses
9 Classes, SysUtils, FPimage, BGRAGraphics, BGRABitmapTypes;
10
11 type
12
13 { TColorEx }
14
15 TColorEx = object
16 private
17 FColorspace: TColorspaceAny;
18 FValue: array[0..31] of byte;
19 private
GetAlphanull20 function GetAlpha: byte;
GetAlphaPercentnull21 function GetAlphaPercent: single;
GetBlacknull22 function GetBlack: single;
GetBlackPercentnull23 function GetBlackPercent: single;
GetBluenull24 function GetBlue: byte;
GetBluePercentnull25 function GetBluePercent: single;
GetCyannull26 function GetCyan: single;
GetCyanPercentnull27 function GetCyanPercent: single;
GetGreennull28 function GetGreen: byte;
GetGreenPercentnull29 function GetGreenPercent: single;
GetIsOpaquenull30 function GetIsOpaque: boolean;
GetIsTransparentnull31 function GetIsTransparent: boolean;
GetLightnessnull32 function GetLightness: single;
GetLightnessPercentnull33 function GetLightnessPercent: single;
GetRednull34 function GetRed: byte;
GetRedPercentnull35 function GetRedPercent: single;
GetSaturationnull36 function GetSaturation: single;
GetSaturationPercentnull37 function GetSaturationPercent: single;
GetYellownull38 function GetYellow: single;
GetYellowPercentnull39 function GetYellowPercent: single;
GetHuenull40 function GetHue: single;
GetHuePercentnull41 function GetHuePercent: single;
GetMagentanull42 function GetMagenta: single;
GetMagentaPercentnull43 function GetMagentaPercent: single;
44 procedure SetYellow(AValue: single);
45 procedure SetYellowPercent(AValue: single);
46 procedure SetAlpha(AValue: byte);
47 procedure SetAlphaPercent(AValue: single);
48 procedure SetBlack(AValue: single);
49 procedure SetBlackPercent(AValue: single);
50 procedure SetBlue(AValue: byte);
51 procedure SetBluePercent(AValue: single);
52 procedure SetCyan(AValue: single);
53 procedure SetCyanPercent(AValue: single);
54 procedure SetGreen(AValue: byte);
55 procedure SetGreenPercent(AValue: single);
56 procedure SetLightness(AValue: single);
57 procedure SetLightnessPercent(AValue: single);
58 procedure SetRed(AValue: byte);
59 procedure SetRedPercent(AValue: single);
60 procedure SetSaturation(AValue: single);
61 procedure SetSaturationPercent(AValue: single);
62 procedure SetHue(AValue: single);
63 procedure SetHuePercent(AValue: single);
64 procedure SetMagenta(AValue: single);
65 procedure SetMagentaPercent(AValue: single);
66 public
Newnull67 class function New: TColorEx; overload; static;
Newnull68 class function New(const AValue: TColorEx): TColorEx; overload; static;
Newnull69 class function New(const AValue: string): TColorEx; overload; static;
Newnull70 class function New(const AValue: TColor): TColorEx; overload; static;
Newnull71 class function New(const AValue: TBGRAPixel): TColorEx; overload; static;
Newnull72 class function New(const AValue: TExpandedPixel): TColorEx; overload; static;
Newnull73 class function New(const AValue: TStdRGBA): TColorEx; overload; static;
Newnull74 class function New(const AValue: TLinearRGBA): TColorEx; overload; static;
Newnull75 class function New(const AValue: TXYZA): TColorEx; overload; static;
Newnull76 class function New(const AValue: TLabA): TColorEx; overload; static;
Newnull77 class function New(const AValue: TStdHSLA): TColorEx; overload; static;
Newnull78 class function New(const AValue: TStdHSVA): TColorEx; overload; static;
Newnull79 class function New(const AValue: TStdCMYK): TColorEx; overload; static;
Newnull80 class function New(const AValue: TLChA): TColorEx; overload; static;
Newnull81 class function New(const ARed, AGreen, ABlue: byte; const AAlpha: byte = 255): TColorEx; overload; static;
82 procedure SetValue(const AValue; AColorspace: TColorspaceAny);
83 procedure GetValue(out AValue; AColorspace: TColorspaceAny);
84 public
ToBGRAPixelnull85 function ToBGRAPixel: TBGRAPixel;
ToColornull86 function ToColor: TColor;
ToDecimalnull87 function ToDecimal: integer;
ToGrayscalenull88 function ToGrayscale: TColorEx;
ToHexnull89 function ToHex: string;
ToStdRGBAnull90 function ToStdRGBA: TStdRGBA;
ToStdHSLAnull91 function ToStdHSLA: TStdHSLA;
ToStdHSVAnull92 function ToStdHSVA: TStdHSVA;
ToStdCMYKnull93 function ToStdCMYK: TStdCMYK;
ToExpandedPixelnull94 function ToExpandedPixel: TExpandedPixel;
ToLinearRGBAnull95 function ToLinearRGBA: TLinearRGBA;
ToAdobeRGBAnull96 function ToAdobeRGBA: TAdobeRGBA;
ToHSLAPixelnull97 function ToHSLAPixel: THSLAPixel;
ToGSBAPixelnull98 function ToGSBAPixel: TGSBAPixel;
ToXYZAnull99 function ToXYZA: TXYZA;
ToLabAnull100 function ToLabA: TLabA;
ToLChAnull101 function ToLChA: TLChA;
ToNamenull102 function ToName: string;
ToStringnull103 function ToString: string;
ToInvertnull104 function ToInvert: TColorEx;
105 procedure FromBGRAPixel(AValue: TBGRAPixel);
106 procedure FromColor(AValue: TColor);
107 procedure FromDecimal(AValue: integer);
108 procedure FromHex(AValue: string);
109 procedure FromStdRGBA(const AValue: TStdRGBA);
110 procedure FromStdHSLA(const AValue: TStdHSLA);
111 procedure FromStdHSVA(const AValue: TStdHSVA);
112 procedure FromStdCMYK(const AValue: TStdCMYK);
113 procedure FromExpandedPixel(const AValue: TExpandedPixel);
114 procedure FromLinearRGBA(const AValue: TLinearRGBA);
115 procedure FromAdobeRGBA(const AValue: TAdobeRGBA);
116 procedure FromHSLAPixel(const AValue: THSLAPixel);
117 procedure FromGSBAPixel(const AValue: TGSBAPixel);
118 procedure FromXYZA(AValue: TXYZA);
119 procedure FromLabA(AValue: TLabA);
120 procedure FromLChA(AValue: TLChA);
121 procedure FromName(AValue: string);
122 procedure FromString(AValue: string);
123 public
Fadenull124 function Fade(APercent: single): TColorEx;
Darkennull125 function Darken(APercent: single): TColorEx;
Lightennull126 function Lighten(APercent: single): TColorEx;
Premultiplynull127 function Premultiply: TColorEx;
128 public
129 property Colorspace: TColorspaceAny read FColorspace;
130 property Red: byte read GetRed write SetRed;
131 property Green: byte read GetGreen write SetGreen;
132 property Blue: byte read GetBlue write SetBlue;
133 property Alpha: byte read GetAlpha write SetAlpha;
134 property Hue: single read GetHue write SetHue;
135 property Saturation: single read GetSaturation write SetSaturation;
136 property Lightness: single read GetLightness write SetLightness;
137 property Cyan: single read GetCyan write SetCyan;
138 property Magenta: single read GetMagenta write SetMagenta;
139 property Yellow: single read GetYellow write SetYellow;
140 property Black: single read GetBlack write SetBlack;
141 property RedPercent: single read GetRedPercent write SetRedPercent;
142 property GreenPercent: single read GetGreenPercent write SetGreenPercent;
143 property BluePercent: single read GetBluePercent write SetBluePercent;
144 property AlphaPercent: single read GetAlphaPercent write SetAlphaPercent;
145 property HuePercent: single read GetHuePercent write SetHuePercent;
146 property SaturationPercent: single read GetSaturationPercent write SetSaturationPercent;
147 property LightnessPercent: single read GetLightnessPercent write SetLightnessPercent;
148 property CyanPercent: single read GetCyanPercent write SetCyanPercent;
149 property MagentaPercent: single read GetMagentaPercent write SetMagentaPercent;
150 property YellowPercent: single read GetYellowPercent write SetYellowPercent;
151 property BlackPercent: single read GetBlackPercent write SetBlackPercent;
152 property Name: string read ToName write FromName;
153 property AsHex: string read ToHex write FromHex;
154 property AsDecimal: integer read ToDecimal write FromDecimal;
155 property AsString: string read ToString write FromString;
156 property AsColor: TColor read ToColor write FromColor;
157 property AsBGRAPixel: TBGRAPixel read ToBGRAPixel write FromBGRAPixel;
158 property AsStdRGBA: TStdRGBA read ToStdRGBA write FromStdRGBA;
159 property AsStdHSLA: TStdHSLA read ToStdHSLA write FromStdHSLA;
160 property AsStdHSVA: TStdHSVA read ToStdHSVA write FromStdHSVA;
161 property AsStdCMYK: TStdCMYK read ToStdCMYK write FromStdCMYK;
162 property AsExpandedPixel: TExpandedPixel read ToExpandedPixel write FromExpandedPixel;
163 property AsLinearRGBA: TLinearRGBA read ToLinearRGBA write FromLinearRGBA;
164 property AsAdobeRGBA: TAdobeRGBA read ToAdobeRGBA write FromAdobeRGBA;
165 property AsHSLAPixel: THSLAPixel read ToHSLAPixel write FromHSLAPixel;
166 property AsGSBAPixel: TGSBAPixel read ToGSBAPixel write FromGSBAPixel;
167 property AsXYZA: TXYZA read ToXYZA write FromXYZA;
168 property AsLabA: TLabA read ToLabA write FromLabA;
169 property AsLChA: TLChA read ToLChA write FromLChA;
170 property AsGrayscale: TColorEx read ToGrayscale;
171 property AsInvert: TColorEx read ToInvert;
172 property IsTransparent: boolean read GetIsTransparent;
173 property IsOpaque: boolean read GetIsOpaque;
174 end;
175
ColorExnull176 function ColorEx(const ARed, AGreen, ABlue: byte; const AAlpha: byte = 255): TColorEx;
ColorExnull177 function ColorEx(const AValue: string): TColorEx;
ColorExnull178 function ColorEx(const AValue: string; const AAlpha: single): TColorEx;
clRandomnull179 function clRandom: TColorEx;
180
181 operator := (const AValue: TColorEx): string;
182 operator := (const AValue: TColorEx): TColor;
183 operator := (const AValue: TColorEx): TBGRAPixel;
184 operator := (const AValue: TColorEx): TExpandedPixel;
185 operator := (const AValue: TColorEx): TStdRGBA;
186 operator := (const AValue: TColorEx): TLinearRGBA;
187 operator := (const AValue: TColorEx): TXYZA;
188 operator := (const AValue: TColorEx): TLabA;
189 operator := (const AValue: TColorEx): TStdHSLA;
190 operator := (const AValue: TColorEx): TStdHSVA;
191 operator := (const AValue: TColorEx): TStdCMYK;
192 operator := (const AValue: TColorEx): TLChA;
193
194 operator := (const AValue: string): TColorEx;
195 operator := (const AValue: TColor): TColorEx;
196 operator := (const AValue: TBGRAPixel): TColorEx;
197 operator := (const AValue: TExpandedPixel): TColorEx;
198 operator := (const AValue: TStdRGBA): TColorEx;
199 operator := (const AValue: TLinearRGBA): TColorEx;
200 operator := (const AValue: TXYZA): TColorEx;
201 operator := (const AValue: TLabA): TColorEx;
202 operator := (const AValue: TStdHSLA): TColorEx;
203 operator := (const AValue: TStdHSVA): TColorEx;
204 operator := (const AValue: TStdCMYK): TColorEx;
205 operator := (const AValue: TLChA): TColorEx;
206
207 implementation
208
ColorExnull209 function ColorEx(const ARed, AGreen, ABlue: byte; const AAlpha: byte): TColorEx;
210 begin
211 Result := TColorEx.New(ARed, AGreen, ABlue, AAlpha);
212 end;
213
ColorExnull214 function ColorEx(const AValue: string): TColorEx;
215 begin
216 Result := TColorEx.New(AValue);
217 end;
218
ColorExnull219 function ColorEx(const AValue: string; const AAlpha: single): TColorEx;
220 begin
221 Result := TColorEx.New(AValue);
222 Result.AlphaPercent := AAlpha;
223 end;
224
clRandomnull225 function clRandom: TColorEx;
226 begin
227 Result := TStdHSLA.New(Random(360), 0.5, 0.5);
228 end;
229
230 operator := (const AValue: TColorEx): string;
231 begin
232 Result := AValue.AsString;
233 end;
234
235 operator := (const AValue: TColorEx): TColor;
236 begin
237 Result := AValue.AsColor;
238 end;
239
240 operator := (const AValue: TColorEx): TBGRAPixel;
241 begin
242 Result := AValue.AsBGRAPixel;
243 end;
244
245 operator := (const AValue: TColorEx): TExpandedPixel;
246 begin
247 Result := AValue.AsExpandedPixel;
248 end;
249
250 operator := (const AValue: TColorEx): TStdRGBA;
251 begin
252 Result := AValue.AsStdRGBA;
253 end;
254
255 operator := (const AValue: TColorEx): TLinearRGBA;
256 begin
257 Result := AValue.AsLinearRGBA;
258 end;
259
260 operator := (const AValue: TColorEx): TXYZA;
261 begin
262 Result := AValue.AsXYZA;
263 end;
264
265 operator := (const AValue: TColorEx): TLabA;
266 begin
267 Result := AValue.AsLabA;
268 end;
269
270 operator := (const AValue: TColorEx): TStdHSLA;
271 begin
272 Result := AValue.AsStdHSLA;
273 end;
274
275 operator := (const AValue: TColorEx): TStdHSVA;
276 begin
277 Result := AValue.AsStdHSVA;
278 end;
279
280 operator := (const AValue: TColorEx): TStdCMYK;
281 begin
282 Result := AValue.AsStdCMYK;
283 end;
284
285 operator := (const AValue: TColorEx): TLChA;
286 begin
287 Result := AValue.AsLChA;
288 end;
289
290 operator := (const AValue: string): TColorEx;
291 begin
292 Result.AsString := AValue;
293 end;
294
295 operator := (const AValue: TColor): TColorEx;
296 begin
297 Result.AsColor := AValue;
298 end;
299
300 operator := (const AValue: TBGRAPixel): TColorEx;
301 begin
302 Result.AsBGRAPixel := AValue;
303 end;
304
305 operator := (const AValue: TExpandedPixel): TColorEx;
306 begin
307 Result.AsExpandedPixel := AValue;
308 end;
309
310 operator := (const AValue: TStdRGBA): TColorEx;
311 begin
312 Result.AsStdRGBA := AValue;
313 end;
314
315 operator := (const AValue: TLinearRGBA): TColorEx;
316 begin
317 Result.AsLinearRGBA := AValue;
318 end;
319
320 operator := (const AValue: TXYZA): TColorEx;
321 begin
322 Result.AsXYZA := AValue;
323 end;
324
325 operator := (const AValue: TLabA): TColorEx;
326 begin
327 Result.AsLabA := AValue;
328 end;
329
330 operator := (const AValue: TStdHSLA): TColorEx;
331 begin
332 Result.AsStdHSLA := AValue;
333 end;
334
335 operator := (const AValue: TStdHSVA): TColorEx;
336 begin
337 Result.AsStdHSVA := AValue;
338 end;
339
340 operator := (const AValue: TStdCMYK): TColorEx;
341 begin
342 Result.AsStdCMYK := AValue;
343 end;
344
345 operator := (const AValue: TLChA): TColorEx;
346 begin
347 Result.AsLChA := AValue;
348 end;
349
350 { TColorEx }
351
GetAlphanull352 function TColorEx.GetAlpha: byte;
353 begin
354 Result := round(AsStdRGBA.alpha * 255);
355 end;
356
TColorEx.GetAlphaPercentnull357 function TColorEx.GetAlphaPercent: single;
358 begin
359 Result := AsStdRGBA.alpha * 100;
360 end;
361
TColorEx.ToBGRAPixelnull362 function TColorEx.ToBGRAPixel: TBGRAPixel;
363 begin
364 GetValue(result, result.Colorspace);
365 end;
366
TColorEx.GetBlacknull367 function TColorEx.GetBlack: single;
368 begin
369 Result := AsStdCMYK.K;
370 end;
371
TColorEx.GetBlackPercentnull372 function TColorEx.GetBlackPercent: single;
373 begin
374 Result := Black * 100;
375 end;
376
TColorEx.GetBluenull377 function TColorEx.GetBlue: byte;
378 begin
379 Result := round(AsStdRGBA.blue * 255);
380 end;
381
GetBluePercentnull382 function TColorEx.GetBluePercent: single;
383 begin
384 Result := AsStdRGBA.blue * 100;
385 end;
386
TColorEx.ToStdCMYKnull387 function TColorEx.ToStdCMYK: TStdCMYK;
388 begin
389 GetValue(result, result.Colorspace);
390 end;
391
ToColornull392 function TColorEx.ToColor: TColor;
393 begin
394 GetValue(result, TColorColorspace);
395 end;
396
TColorEx.GetCyannull397 function TColorEx.GetCyan: single;
398 begin
399 Result := AsStdCMYK.C;
400 end;
401
GetCyanPercentnull402 function TColorEx.GetCyanPercent: single;
403 begin
404 Result := Cyan * 100;
405 end;
406
TColorEx.ToDecimalnull407 function TColorEx.ToDecimal: integer;
408 begin
409 with AsBGRAPixel do
410 Result := (red shl 16) or (green shl 8) or blue;
411 end;
412
TColorEx.ToExpandedPixelnull413 function TColorEx.ToExpandedPixel: TExpandedPixel;
414 begin
415 GetValue(result, result.Colorspace);
416 end;
417
ToGrayscalenull418 function TColorEx.ToGrayscale: TColorEx;
419 begin
420 Result.AsStdRGBA := AsBGRAPixel.ToGrayscale(True);
421 end;
422
GetGreennull423 function TColorEx.GetGreen: byte;
424 begin
425 Result := round(AsStdRGBA.green * 255);
426 end;
427
GetGreenPercentnull428 function TColorEx.GetGreenPercent: single;
429 begin
430 Result := AsStdRGBA.green * 100;
431 end;
432
GetIsOpaquenull433 function TColorEx.GetIsOpaque: boolean;
434 begin
435 Result := AlphaPercent >= 100;
436 end;
437
TColorEx.GetIsTransparentnull438 function TColorEx.GetIsTransparent: boolean;
439 begin
440 Result := AlphaPercent <= 0;
441 end;
442
ToHexnull443 function TColorEx.ToHex: string;
444 begin
445 with AsBGRAPixel do
446 begin
447 Result := '#' + IntToHex(red, 2) + IntToHex(green, 2) + IntToHex(blue, 2);
448 if alpha <> 255 then
449 Result += IntToHex(alpha, 2);
450 end;
451 end;
452
TColorEx.ToStdHSLAnull453 function TColorEx.ToStdHSLA: TStdHSLA;
454 begin
455 GetValue(result, result.Colorspace);
456 end;
457
TColorEx.ToStdHSVAnull458 function TColorEx.ToStdHSVA: TStdHSVA;
459 begin
460 GetValue(result, result.Colorspace);
461 end;
462
TColorEx.GetHuenull463 function TColorEx.GetHue: single;
464 begin
465 Result := AsStdHSLA.hue * 100;
466 end;
467
TColorEx.GetHuePercentnull468 function TColorEx.GetHuePercent: single;
469 begin
470 Result := Hue / 3.6;
471 end;
472
TColorEx.ToInvertnull473 function TColorEx.ToInvert: TColorEx;
474 begin
475 with AsStdRGBA do
476 begin
477 Result.AsStdRGBA := TStdRGBA.New(1 - red, 1 - green, 1 - blue, alpha);
478 end;
479 end;
480
TColorEx.ToLabAnull481 function TColorEx.ToLabA: TLabA;
482 begin
483 GetValue(result, result.Colorspace);
484 end;
485
TColorEx.ToLChAnull486 function TColorEx.ToLChA: TLChA;
487 begin
488 GetValue(result, result.Colorspace);
489 end;
490
GetLightnessnull491 function TColorEx.GetLightness: single;
492 begin
493 Result := AsStdHSLA.lightness;
494 end;
495
GetLightnessPercentnull496 function TColorEx.GetLightnessPercent: single;
497 begin
498 Result := Lightness * 100;
499 end;
500
TColorEx.ToLinearRGBAnull501 function TColorEx.ToLinearRGBA: TLinearRGBA;
502 begin
503 GetValue(result, result.Colorspace);
504 end;
505
ToAdobeRGBAnull506 function TColorEx.ToAdobeRGBA: TAdobeRGBA;
507 begin
508 GetValue(result, result.Colorspace);
509 end;
510
ToHSLAPixelnull511 function TColorEx.ToHSLAPixel: THSLAPixel;
512 begin
513 GetValue(result, result.Colorspace);
514 end;
515
TColorEx.ToGSBAPixelnull516 function TColorEx.ToGSBAPixel: TGSBAPixel;
517 begin
518 GetValue(result, result.Colorspace);
519 end;
520
GetMagentanull521 function TColorEx.GetMagenta: single;
522 begin
523 Result := AsStdCMYK.M;
524 end;
525
TColorEx.GetMagentaPercentnull526 function TColorEx.GetMagentaPercent: single;
527 begin
528 Result := Magenta * 100;
529 end;
530
TColorEx.ToNamenull531 function TColorEx.ToName: string;
532 var
533 idx: integer;
534 c: TBGRAPixel;
535 begin
536 Result := '';
537 c := AsBGRAPixel;
538 if Assigned(CSSColors) then
539 begin
540 idx := CSSColors.IndexOfColor(c, 1000);
541 if idx <> -1 then
542 begin
543 Result := CSSColors.Name[idx];
544 exit;
545 end;
546 end;
547 end;
548
TColorEx.GetRednull549 function TColorEx.GetRed: byte;
550 begin
551 Result := round(AsStdRGBA.red * 255);
552 end;
553
GetRedPercentnull554 function TColorEx.GetRedPercent: single;
555 begin
556 Result := AsStdRGBA.red * 100;
557 end;
558
TColorEx.GetSaturationnull559 function TColorEx.GetSaturation: single;
560 begin
561 Result := AsStdHSLA.saturation;
562 end;
563
GetSaturationPercentnull564 function TColorEx.GetSaturationPercent: single;
565 begin
566 Result := Saturation * 100;
567 end;
568
TColorEx.ToStdRGBAnull569 function TColorEx.ToStdRGBA: TStdRGBA;
570 begin
571 GetValue(result, result.Colorspace);
572 end;
573
ToStringnull574 function TColorEx.ToString: string;
575 begin
576 Result := BGRAToStr(AsBGRAPixel);
577 end;
578
TColorEx.ToXYZAnull579 function TColorEx.ToXYZA: TXYZA;
580 begin
581 GetValue(result, result.Colorspace);
582 end;
583
TColorEx.GetYellownull584 function TColorEx.GetYellow: single;
585 begin
586 Result := AsStdCMYK.Y;
587 end;
588
GetYellowPercentnull589 function TColorEx.GetYellowPercent: single;
590 begin
591 Result := Yellow * 100;
592 end;
593
594 procedure TColorEx.SetAlpha(AValue: byte);
595 begin
596 with AsStdRGBA do
597 Self.AsStdRGBA := TStdRGBA.New(red, green, blue, AValue / 255);
598 end;
599
600 procedure TColorEx.SetAlphaPercent(AValue: single);
601 begin
602 with AsStdRGBA do
603 Self.AsStdRGBA := TStdRGBA.New(red, green, blue, AValue / 100);
604 end;
605
606 procedure TColorEx.FromBGRAPixel(AValue: TBGRAPixel);
607 begin
608 SetValue(AValue, AValue.Colorspace);
609 end;
610
611 procedure TColorEx.SetBlack(AValue: single);
612 begin
613 with AsStdCMYK do
614 Self.AsStdCMYK := TStdCMYK.New(C, M, Y, AValue);
615 end;
616
617 procedure TColorEx.SetBlackPercent(AValue: single);
618 begin
619 with AsStdCMYK do
620 Self.AsStdCMYK := TStdCMYK.New(C, M, Y, AValue / 100);
621 end;
622
623 procedure TColorEx.SetBlue(AValue: byte);
624 begin
625 with AsStdRGBA do
626 Self.AsStdRGBA := TStdRGBA.New(red, green, AValue / 255, alpha);
627 end;
628
629 procedure TColorEx.SetBluePercent(AValue: single);
630 begin
631 with AsStdRGBA do
632 Self.AsStdRGBA := TStdRGBA.New(red, green, AValue / 100, alpha);
633 end;
634
635 procedure TColorEx.FromStdCMYK(const AValue: TStdCMYK);
636 begin
637 SetValue(AValue, AValue.Colorspace);
638 end;
639
640 procedure TColorEx.FromColor(AValue: TColor);
641 begin
642 SetValue(AValue, AValue.Colorspace);
643 end;
644
645 procedure TColorEx.SetCyan(AValue: single);
646 begin
647 with AsStdCMYK do
648 Self.AsStdCMYK:= TStdCMYK.New(AValue, M, Y, K);
649 end;
650
651 procedure TColorEx.SetCyanPercent(AValue: single);
652 begin
653 with AsStdCMYK do
654 Self.AsStdCMYK := TStdCMYK.New(AValue / 100, M, Y, K);
655 end;
656
657 procedure TColorEx.FromDecimal(AValue: integer);
658 var
659 r, g, b: byte;
660 begin
661 r := (AValue shr 16) and $000000ff;
662 g := (AValue shr 8) and $000000ff;
663 b := AValue and $000000ff;
664 AsBGRAPixel := TBGRAPixel.New(r, g, b);
665 end;
666
667 procedure TColorEx.FromExpandedPixel(const AValue: TExpandedPixel);
668 begin
669 SetValue(AValue, AValue.Colorspace);
670 end;
671
672 procedure TColorEx.SetGreen(AValue: byte);
673 begin
674 with AsStdRGBA do
675 Self.AsStdRGBA := TStdRGBA.New(red, AValue / 255, blue, alpha);
676 end;
677
678 procedure TColorEx.SetGreenPercent(AValue: single);
679 begin
680 with AsStdRGBA do
681 Self.AsStdRGBA := TStdRGBA.New(red, AValue / 100, blue, alpha);
682 end;
683
684 procedure TColorEx.FromHex(AValue: string);
685 var
686 missingValues, error: boolean;
687 c: TBGRAPixel;
688 begin
689 c := BGRAPixelTransparent;
690 TryStrToBGRA(AValue, c, missingValues, error);
691 if not (missingValues or error) then
692 AsBGRAPixel := c;
693 end;
694
695 procedure TColorEx.FromStdHSLA(const AValue: TStdHSLA);
696 begin
697 SetValue(AValue, AValue.Colorspace);
698 end;
699
700 procedure TColorEx.FromStdHSVA(const AValue: TStdHSVA);
701 begin
702 SetValue(AValue, AValue.Colorspace);
703 end;
704
705 procedure TColorEx.FromHSLAPixel(const AValue: THSLAPixel);
706 begin
707 SetValue(AValue, AValue.Colorspace);
708 end;
709
710 procedure TColorEx.FromGSBAPixel(const AValue: TGSBAPixel);
711 begin
712 SetValue(AValue, AValue.Colorspace);
713 end;
714
715 procedure TColorEx.SetHue(AValue: single);
716 begin
717 with AsStdHSLA do
718 Self.AsStdHSLA := TStdHSLA.New(AValue, saturation, lightness, alpha);
719 end;
720
721 procedure TColorEx.SetHuePercent(AValue: single);
722 begin
723 with AsStdHSLA do
724 Self.AsStdHSLA := TStdHSLA.New(AValue / 3.6, saturation, lightness, alpha);
725 end;
726
727 procedure TColorEx.FromLabA(AValue: TLabA);
728 begin
729 SetValue(AValue, AValue.Colorspace);
730 end;
731
732 procedure TColorEx.FromLChA(AValue: TLChA);
733 begin
734 SetValue(AValue, AValue.Colorspace);
735 end;
736
737 procedure TColorEx.SetLightness(AValue: single);
738 begin
739 with AsStdHSLA do
740 Self.AsStdHSLA := TStdHSLA.New(hue, saturation, AValue, alpha);
741 end;
742
743 procedure TColorEx.SetLightnessPercent(AValue: single);
744 begin
745 with AsStdHSLA do
746 Self.AsStdHSLA := TStdHSLA.New(hue, saturation, AValue / 100, alpha);
747 end;
748
749 procedure TColorEx.FromLinearRGBA(const AValue: TLinearRGBA);
750 begin
751 SetValue(AValue, AValue.Colorspace);
752 end;
753
754 procedure TColorEx.FromAdobeRGBA(const AValue: TAdobeRGBA);
755 begin
756 SetValue(AValue, AValue.Colorspace);
757 end;
758
759 procedure TColorEx.SetMagenta(AValue: single);
760 begin
761 with AsStdCMYK do
762 Self.AsStdCMYK := TStdCMYK.New(C, AValue, Y, K);
763 end;
764
765 procedure TColorEx.SetMagentaPercent(AValue: single);
766 begin
767 with AsStdCMYK do
768 Self.AsStdCMYK := TStdCMYK.New(C, AValue / 100, Y, K);
769 end;
770
TColorEx.Newnull771 class function TColorEx.New: TColorEx;
772 begin
773 Result := BGRAPixelTransparent;
774 end;
775
776 procedure TColorEx.FromName(AValue: string);
777 var
778 missingValues, error: boolean;
779 c: TBGRAPixel;
780 begin
781 c := BGRAPixelTransparent;
782 TryStrToBGRA(AValue, c, missingValues, error);
783 if not (missingValues or error) then
784 AsBGRAPixel := c;
785 end;
786
787 procedure TColorEx.SetRed(AValue: byte);
788 begin
789 with AsStdRGBA do
790 Self.AsStdRGBA := TStdRGBA.New(AValue / 255, green, blue, alpha);
791 end;
792
793 procedure TColorEx.SetRedPercent(AValue: single);
794 begin
795 with AsStdRGBA do
796 Self.AsStdRGBA := TStdRGBA.New(AValue / 100, green, blue, alpha);
797 end;
798
799 procedure TColorEx.SetSaturation(AValue: single);
800 begin
801 with AsStdHSLA do
802 Self.AsStdHSLA := TStdHSLA.New(hue, AValue, lightness, alpha);
803 end;
804
805 procedure TColorEx.SetSaturationPercent(AValue: single);
806 begin
807 with AsStdHSLA do
808 Self.AsStdHSLA := TStdHSLA.New(hue, AValue / 100, lightness, alpha);
809 end;
810
811 procedure TColorEx.FromStdRGBA(const AValue: TStdRGBA);
812 begin
813 SetValue(AValue, AValue.Colorspace);
814 end;
815
816 procedure TColorEx.FromString(AValue: string);
817 begin
818 AsBGRAPixel := StrToBGRA(AValue);
819 end;
820
821 procedure TColorEx.FromXYZA(AValue: TXYZA);
822 begin
823 SetValue(AValue, AValue.Colorspace);
824 end;
825
TColorEx.Fadenull826 function TColorEx.Fade(APercent: single): TColorEx;
827 begin
828 Result := Self;
829 if APercent = 1 then
830 Exit;
831 Result.AlphaPercent := Result.AlphaPercent * APercent;
832 end;
833
TColorEx.Darkennull834 function TColorEx.Darken(APercent: single): TColorEx;
835 begin
836 Result := Self;
837 Result.LightnessPercent := Result.LightnessPercent - APercent;
838 end;
839
TColorEx.Lightennull840 function TColorEx.Lighten(APercent: single): TColorEx;
841 begin
842 Result := Self;
843 Result.LightnessPercent := Result.LightnessPercent + APercent;
844 end;
845
Premultiplynull846 function TColorEx.Premultiply: TColorEx;
847 begin
848 with AsStdRGBA do
849 Self.AsStdRGBA:= TStdRGBA.New(red*alpha,green*alpha,blue*alpha,alpha);
850 Result:=Self;
851 end;
852
853 procedure TColorEx.SetYellow(AValue: single);
854 begin
855 with AsStdCMYK do
856 Self.AsStdCMYK := TStdCMYK.New(C, M, AValue, K);
857 end;
858
859 procedure TColorEx.SetYellowPercent(AValue: single);
860 begin
861 with AsStdCMYK do
862 Self.AsStdCMYK := TStdCMYK.New(C, M, AValue / 100, K);
863 end;
864
TColorEx.Newnull865 class function TColorEx.New(const AValue: TColorEx): TColorEx;
866 begin
867 Result := AValue;
868 end;
869
TColorEx.Newnull870 class function TColorEx.New(const AValue: string): TColorEx;
871 begin
872 Result := AValue;
873 end;
874
TColorEx.Newnull875 class function TColorEx.New(const AValue: TColor): TColorEx;
876 begin
877 Result := AValue;
878 end;
879
TColorEx.Newnull880 class function TColorEx.New(const AValue: TBGRAPixel): TColorEx;
881 begin
882 Result := AValue;
883 end;
884
TColorEx.Newnull885 class function TColorEx.New(const AValue: TExpandedPixel): TColorEx;
886 begin
887 Result := AValue;
888 end;
889
TColorEx.Newnull890 class function TColorEx.New(const AValue: TStdRGBA): TColorEx;
891 begin
892 Result := AValue;
893 end;
894
TColorEx.Newnull895 class function TColorEx.New(const AValue: TLinearRGBA): TColorEx;
896 begin
897 Result := AValue;
898 end;
899
TColorEx.Newnull900 class function TColorEx.New(const AValue: TXYZA): TColorEx;
901 begin
902 Result := AValue;
903 end;
904
TColorEx.Newnull905 class function TColorEx.New(const AValue: TLabA): TColorEx;
906 begin
907 Result := AValue;
908 end;
909
TColorEx.Newnull910 class function TColorEx.New(const AValue: TStdHSLA): TColorEx;
911 begin
912 Result := AValue;
913 end;
914
TColorEx.Newnull915 class function TColorEx.New(const AValue: TStdHSVA): TColorEx;
916 begin
917 Result := AValue;
918 end;
919
TColorEx.Newnull920 class function TColorEx.New(const AValue: TStdCMYK): TColorEx;
921 begin
922 Result := AValue;
923 end;
924
TColorEx.Newnull925 class function TColorEx.New(const AValue: TLChA): TColorEx;
926 begin
927 Result := AValue;
928 end;
929
TColorEx.Newnull930 class function TColorEx.New(const ARed, AGreen, ABlue: byte; const AAlpha: byte): TColorEx;
931 begin
932 Result := TStdRGBA.New(ARed / 255, AGreen / 255, ABlue / 255, AAlpha / 255);
933 end;
934
935 procedure TColorEx.SetValue(const AValue; AColorspace: TColorspaceAny);
936 begin
937 FColorspace:= AColorspace;
938 move(AValue, FValue, AColorspace.GetSize);
939 end;
940
941 procedure TColorEx.GetValue(out AValue; AColorspace: TColorspaceAny);
942 begin
943 if Assigned(FColorspace) then
944 FColorspace.Convert(FValue, AValue, AColorspace)
945 else
946 TBGRAPixelColorspace.Convert(BGRAPixelTransparent, AValue, AColorspace)
947 end;
948
949 end.
950