RColors.pas

unit RColors;

interface

uses SysUtils, Windows, Graphics;

// Colours
type
  TRGB = record
    rgbRed, rgbGreen, rgbBlue: double;
  end;

  THSL = record
    hslHue, hslSaturation, hslLightness: double;
  end;

  THSV = record
    hsvHue, hsvSaturation, hsvValue: double;
  end;

const
  CSSColorNames: array[0..146] of array[0..1] of string =
    (('aliceblue', '#F0F8FF'),
    ('antiquewhite', '#FAEBD7'),
    ('aqua', '#00FFFF'),
    ('aquamarine', '#7FFFD4'),
    ('azure', '#F0FFFF'),
    ('beige', '#F5F5DC'),
    ('bisque', '#FFE4C4'),
    ('black', '#000000'),
    ('blanchedalmond', '#FFEBCD'),
    ('blue', '#0000FF'),
    ('blueviolet', '#8A2BE2'),
    ('brown', '#A52A2A'),
    ('burlywood', '#DEB887'),
    ('cadetblue', '#5F9EA0'),
    ('chartreuse', '#7FFF00'),
    ('chocolate', '#D2691E'),
    ('coral', '#FF7F50'),
    ('cornflowerblue', '#6495ED'),
    ('cornsilk', '#FFF8DC'),
    ('crimson', '#DC143C'),
    ('cyan', '#00FFFF'),
    ('darkblue', '#00008B'),
    ('darkcyan', '#008B8B'),
    ('darkgoldenrod', '#B8860B'),
    ('darkgray', '#A9A9A9'),
    ('darkgreen', '#006400'),
    ('darkgrey', '#A9A9A9'),
    ('darkkhaki', '#BDB76B'),
    ('darkmagenta', '#8B008B'),
    ('darkolivegreen', '#556B2F'),
    ('darkorange', '#FF8C00'),
    ('darkorchid', '#9932CC'),
    ('darkred', '#8B0000'),
    ('darksalmon', '#E9967A'),
    ('darkseagreen', '#8FBC8F'),
    ('darkslateblue', '#483D8B'),
    ('darkslategray', '#2F4F4F'),
    ('darkslategrey', '#2F4F4F'),
    ('darkturquoise', '#00CED1'),
    ('darkviolet', '#9400D3'),
    ('deeppink', '#FF1493'),
    ('deepskyblue', '#00BFFF'),
    ('dimgray', '#696969'),
    ('dimgrey', '#696969'),
    ('dodgerblue', '#1E90FF'),
    ('firebrick', '#B22222'),
    ('floralwhite', '#FFFAF0'),
    ('forestgreen', '#228B22'),
    ('fuchsia', '#FF00FF'),
    ('gainsboro', '#DCDCDC'),
    ('ghostwhite', '#F8F8FF'),
    ('gold', '#FFD700'),
    ('goldenrod', '#DAA520'),
    ('gray', '#808080'),
    ('green', '#008000'),
    ('greenyellow', '#ADFF2F'),
    ('grey', '#808080'),
    ('honeydew', '#F0FFF0'),
    ('hotpink', '#FF69B4'),
    ('indianred', '#CD5C5C'),
    ('indigo', '#4B0082'),
    ('ivory', '#FFFFF0'),
    ('khaki', '#F0E68C'),
    ('lavender', '#E6E6FA'),
    ('lavenderblush', '#FFF0F5'),
    ('lawngreen', '#7CFC00'),
    ('lemonchiffon', '#FFFACD'),
    ('lightblue', '#ADD8E6'),
    ('lightcoral', '#F08080'),
    ('lightcyan', '#E0FFFF'),
    ('lightgoldenrodyellow', '#FAFAD2'),
    ('lightgray', '#D3D3D3'),
    ('lightgreen', '#90EE90'),
    ('lightgrey', '#D3D3D3'),
    ('lightpink', '#FFB6C1'),
    ('lightsalmon', '#FFA07A'),
    ('lightseagreen', '#20B2AA'),
    ('lightskyblue', '#87CEFA'),
    ('lightslategray', '#778899'),
    ('lightslategrey', '#778899'),
    ('lightsteelblue', '#B0C4DE'),
    ('lightyellow', '#FFFFE0'),
    ('lime', '#00FF00'),
    ('limegreen', '#32CD32'),
    ('linen', '#FAF0E6'),
    ('magenta', '#FF00FF'),
    ('maroon', '#800000'),
    ('mediumaquamarine', '#66CDAA'),
    ('mediumblue', '#0000CD'),
    ('mediumorchid', '#BA55D3'),
    ('mediumpurple', '#9370DB'),
    ('mediumseagreen', '#3CB371'),
    ('mediumslateblue', '#7B68EE'),
    ('mediumspringgreen', '#00FA9A'),
    ('mediumturquoise', '#48D1CC'),
    ('mediumvioletred', '#C71585'),
    ('midnightblue', '#191970'),
    ('mintcream', '#F5FFFA'),
    ('mistyrose', '#FFE4E1'),
    ('moccasin', '#FFE4B5'),
    ('navajowhite', '#FFDEAD'),
    ('navy', '#000080'),
    ('oldlace', '#FDF5E6'),
    ('olive', '#808000'),
    ('olivedrab', '#6B8E23'),
    ('orange', '#FFA500'),
    ('orangered', '#FF4500'),
    ('orchid', '#DA70D6'),
    ('palegoldenrod', '#EEE8AA'),
    ('palegreen', '#98FB98'),
    ('paleturquoise', '#AFEEEE'),
    ('palevioletred', '#DB7093'),
    ('papayawhip', '#FFEFD5'),
    ('peachpuff', '#FFDAB9'),
    ('peru', '#CD853F'),
    ('pink', '#FFC0CB'),
    ('plum', '#DDA0DD'),
    ('powderblue', '#B0E0E6'),
    ('purple', '#800080'),
    ('red', '#FF0000'),
    ('rosybrown', '#BC8F8F'),
    ('royalblue', '#4169E1'),
    ('saddlebrown', '#8B4513'),
    ('salmon', '#FA8072'),
    ('sandybrown', '#F4A460'),
    ('seagreen', '#2E8B57'),
    ('seashell', '#FFF5EE'),
    ('sienna', '#A0522D'),
    ('silver', '#C0C0C0'),
    ('skyblue', '#87CEEB'),
    ('slateblue', '#6A5ACD'),
    ('slategray', '#708090'),
    ('slategrey', '#708090'),
    ('snow', '#FFFAFA'),
    ('springgreen', '#00FF7F'),
    ('steelblue', '#4682B4'),
    ('tan', '#D2B48C'),
    ('teal', '#008080'),
    ('thistle', '#D8BFD8'),
    ('tomato', '#FF6347'),
    ('turquoise', '#40E0D0'),
    ('violet', '#EE82EE'),
    ('wheat', '#F5DEB3'),
    ('white', '#FFFFFF'),
    ('whitesmoke', '#F5F5F5'),
    ('yellow', '#FFFF00'),
    ('yellowgreen', '#9ACD32'));

function InvertColor(const Color: TColor): TColor; overload;
function InvertColor(const Color: TRGBQuad): TRGBQuad; overload;
function InvertColor(const Color: TRGB): TRGB; overload;
function EqualRGBQuad3(const Quad1: TRGBQuad; const Quad2: TRGBQuad): boolean; inline;
function EqualRGBQuad4(const Quad1: TRGBQuad; const Quad2: TRGBQuad): boolean; inline;
function Fix360(const a: Real): real; inline;
function PascalColorToRGB(const Color: TColor): TRGB; inline;
function PascalColorToRGBQuad(const Color: TColor): TRGBQuad; inline;
function RGBQuadToRGB(const Color: TRGBQuad): TRGB;
function RGBToRGBQuad(const Color: TRGB): TRGBQuad;
function RGBTripleToRGB(const Color: TRGBTriple): TRGB;
function RGBToRGBTriple(const Color: TRGB): TRGBTriple;
function RGBQuadEqual(const Color1: TRGBQuad; const Color2: TRGBQuad): boolean;
function RGBTripleEqual(const Color1: TRGBTriple; const Color2: TRGBTriple): boolean;
function GetPascalColor(const Color: TRGB): TColor; overload; inline;
function GetPascalColor(const Color: THSL): TColor; overload; inline;
function GetPascalColor(const Color: THSV): TColor; overload; inline;
function RGB(const R: double; const G: double; const B: double): TRGB; inline;
function HSL(const H: double; const S: double; const L: double): THSL; inline;
function HSV(const H: double; const S: double; const V: double): THSV; inline;
function RGBToHSL(const Color: TRGB): THSL;
function RGBToHSV(const Color: TRGB): THSV;
function HSLToRGB(const Color: THSL): TRGB;
function HSVToRGB(const Color: THSV): TRGB;
function MaxComponent(const Color: TRGB): real; overload;
function MaxComponent(const Color: THSL): real; overload;
function MaxComponent(const Color: THSV): real; overload;
function MinComponent(const Color: TRGB): real; overload;
function MinComponent(const Color: THSL): real; overload;
function MinComponent(const Color: THSV): real; overload;
function IsValidColor(const Color: TRGB): boolean; overload;
function IsValidColor(const Color: THSL): boolean; overload;
function IsValidColor(const Color: THSV): boolean; overload;
function SameRGB(const AColor1, AColor2: TRGB): boolean;
function SameHSV(const AColor1, AColor2: THSV): boolean;
function CSSColorParse(const CSSColor: string): TColor;
function HexColorCodeToColor(const S: string): TColor;
function ColorIsDark(AColor: TColor): boolean;

implementation

uses Math;

function PascalColorToRGB(const Color: TColor): TRGB;
begin
  with result do
  begin
    rgbRed := GetRValue(Color) / 255;
    rgbGreen := GetGValue(Color) / 255;
    rgbBlue := GetBValue(Color) / 255;
  end;
end;

function PascalColorToRGBQuad(const Color: TColor): TRGBQuad;
begin
  with Result do
  begin
    rgbBlue := GetBValue(Color);
    rgbGreen := GetGValue(Color);
    rgbRed := GetRValue(Color);
    rgbReserved := 0;
  end;
end;

function RGBQuadToRGB(const Color: TRGBQuad): TRGB;
begin
  result.rgbRed := Color.rgbRed / 255;
  result.rgbGreen := Color.rgbGreen / 255;
  result.rgbBlue := Color.rgbBlue / 255;
end;

function RGBToRGBQuad(const Color: TRGB): TRGBQuad;
begin
  result.rgbRed := round(255 * Color.rgbRed);
  result.rgbGreen := round(255 * Color.rgbGreen);
  result.rgbBlue := round(255 * Color.rgbBlue);
end;

function RGBTripleToRGB(const Color: TRGBTriple): TRGB;
begin
  result.rgbRed := Color.rgbtRed / 255;
  result.rgbGreen := Color.rgbtGreen / 255;
  result.rgbBlue := Color.rgbtBlue / 255;
end;

function RGBToRGBTriple(const Color: TRGB): TRGBTriple;
begin
  result.rgbtRed := round(255 * Color.rgbRed);
  result.rgbtGreen := round(255 * Color.rgbGreen);
  result.rgbtBlue := round(255 * Color.rgbBlue);
end;

function RGBQuadEqual(const Color1: TRGBQuad; const Color2: TRGBQuad): boolean;
begin
  RGBQuadEqual := (Color1.rgbBlue = Color2.rgbBlue) and
                  (Color1.rgbGreen = Color2.rgbGreen) and
                  (Color1.rgbRed = Color2.rgbRed);
end;

function RGBTripleEqual(const Color1: TRGBTriple; const Color2: TRGBTriple): boolean;
begin
  RGBTripleEqual := (Color1.rgbtBlue = Color2.rgbtBlue) and
                    (Color1.rgbtGreen = Color2.rgbtGreen) and
                    (Color1.rgbtRed = Color2.rgbtRed);
end;

function GetPascalColor(const Color: TRGB): TColor;
begin
  with Color do
    result := Windows.RGB(round(255*rgbRed), round(255*rgbGreen), round(255*rgbBlue));
end;

function GetPascalColor(const Color: THSL): TColor;
var
  FRGB: TRGB;
begin
  FRGB := HSLToRGB(Color);
  with FRGB do
    result := Windows.RGB(round(255*rgbRed), round(255*rgbGreen), round(255*rgbBlue));
end;

function GetPascalColor(const Color: THSV): TColor;
var
  FRGB: TRGB;
begin
  FRGB := HSVToRGB(Color);
  with FRGB do
    result := Windows.RGB(round(255*rgbRed), round(255*rgbGreen), round(255*rgbBlue));
end;

function RGB(const R: Double; const G: Double; const B: Double): TRGB;
begin
  with result do
  begin
    rgbRed := R;
    rgbGreen := G;
    rgbBlue := B;
  end;
end;

function HSL(const H: Double; const S: Double; const L: Double): THSL;
begin
  with result do
  begin
    hslHue := H;
    hslSaturation := S;
    hslLightness := L;
  end;
end;

function HSV(const H: Double; const S: Double; const V: Double): THSV;
begin
  with result do
  begin
    hsvHue := H;
    hsvSaturation := S;
    hsvValue := V;
  end;
end;

function RGBToHSL(const Color: TRGB): THSL;
var
  cmax, cmin, cdiff, csum: real;
begin
  cmax := MaxComponent(Color);
  cmin := MinComponent(Color);
  cdiff := cmax - cmin;
  csum := cmax + cmin;

  with Color, result do
  begin

    // Hue
    if cmax = cmin then
      hslHue := 0
    else if cmax = rgbRed then
      hslHue := (60 * (rgbGreen - rgbBlue) / cdiff)
    else if cmax = rgbGreen then
      hslHue := (60 * (rgbBlue - rgbRed) / cdiff) + 120
    else
      hslHue := (60 * (rgbRed - rgbGreen) / cdiff) + 240;

    hslHue := Fix360(hslHue);

    // Saturation
    if cmax = cmin then
      hslSaturation := 0
    else if csum <= 1 then
      hslSaturation := cdiff / csum
    else
      hslSaturation := cdiff / (2 - csum);

    // Lightness
    hslLightness := csum / 2;

  end;

end;

function RGBToHSV(const Color: TRGB): THSV;
var
  cmax, cmin, cdiff: real;
begin
  cmax := MaxComponent(Color);
  cmin := MinComponent(Color);
  cdiff := cmax - cmin;

  with Color, result do
  begin

    // Hue
    if cmax = cmin then
      hsvHue := 0
    else if cmax = rgbRed then
      hsvHue := (60 * (rgbGreen - rgbBlue) / cdiff)
    else if cmax = rgbGreen then
      hsvHue := (60 * (rgbBlue - rgbRed) / cdiff) + 120
    else
      hsvHue := (60 * (rgbRed - rgbGreen) / cdiff) + 240;

    hsvHue := Fix360(hsvHue);

    // Saturation
    if cmax = 0 then
      hsvSaturation := 0
    else
      hsvSaturation := 1 - cmin / cmax;

    // Value
    hsvValue := cmax;

  end;

end;

function HSLToRGB(const Color: THSL): TRGB;
var
  q, p, hk, tr, tg, tb: real;
begin

  with Color, result do
  begin

    if hslLightness < 0.5 then
      q := hslLightness * (1 + hslSaturation)
    else
      q := hslLightness + hslSaturation - (hslLightness * hslSaturation);

    p := 2 * hslLightness - q;

    hk := hslHue / 360;

    tr := hk + 1/3;
    tg := hk;
    tb := hk - 1/3;

    if tr < 0 then tr := tr + 1;
    if tg < 0 then tg := tg + 1;
    if tb < 0 then tb := tb + 1;

    if tr > 1 then tr := tr - 1;
    if tg > 1 then tg := tg - 1;
    if tb > 1 then tb := tb - 1;

    if tr < 1/6 then
      rgbRed := p + ((q - p) * 6 * tr)
    else if tr < 0.5 then
      rgbRed := q
    else if tr < 2/3 then
      rgbRed := p + ((q - p) * 6 * (2/3 - tr))
    else
      rgbRed := p;

    if tg < 1/6 then
      rgbGreen := p + ((q - p) * 6 * tg)
    else if tg < 0.5 then
      rgbGreen := q
    else if tg < 2/3 then
      rgbGreen := p + ((q - p) * 6 * (2/3 - tg))
    else
      rgbGreen := p;

    if tb < 1/6 then
      rgbBlue := p + ((q - p) * 6 * tb)
    else if tb < 0.5 then
      rgbBlue := q
    else if tb < 2/3 then
      rgbBlue := p + ((q - p) * 6 * (2/3 - tb))
    else
      rgbBlue := p;

  end;

end;

function HSVToRGB(const Color: THSV): TRGB;
var
  hi: integer;
  f, q, p, t: real;
begin

  with Color do
  begin

    hi := floor(hsvHue / 60) mod 6;
    f := hsvHue / 60 - floor(hsvHue / 60);
    p := hsvValue * (1 - hsvSaturation);
    q := hsvValue * (1 - f * hsvSaturation);
    t := hsvValue * (1 - (1 - f) * hsvSaturation);

    case hi of
      0: result := RGB(hsvValue, t, p);
      1: result := RGB(q, hsvValue, p);
      2: result := RGB(p, hsvValue, t);
      3: result := RGB(p, q, hsvValue);
      4: result := RGB(t, p, hsvValue);
      5: result := RGB(hsvValue, p, q);
    end;

  end;

end;

function MaxComponent(const Color: TRGB): real;
begin
  with Color do
    result := max(max(rgbRed, rgbGreen), rgbBlue);
end;

function MaxComponent(const Color: THSL): real;
begin
  with Color do
    result := max(max(hslHue, hslSaturation), hslLightness);
end;

function MaxComponent(const Color: THSV): real;
begin
  with Color do
    result := max(max(hsvHue, hsvSaturation), hsvValue);
end;

function MinComponent(const Color: TRGB): real;
begin
  with Color do
    result := min(min(rgbRed, rgbGreen), rgbBlue);
end;

function MinComponent(const Color: THSL): real;
begin
  with Color do
    result := min(min(hslHue, hslSaturation), hslLightness);
end;

function MinComponent(const Color: THSV): real;
begin
  with Color do
    result := min(min(hsvHue, hsvSaturation), hsvValue);
end;

function IsValidColor(const Color: TRGB): boolean;
begin
  with Color do
    result := (rgbRed >= 0) and (rgbRed <= 1) and
              (rgbGreen >= 0) and (rgbGreen <= 1) and
              (rgbBlue >= 0) and (rgbBlue <= 1);
end;

function IsValidColor(const Color: THSL): boolean;
begin
  with Color do
    result := (hslHue >= 0) and (hslHue < 360) and
              (hslSaturation >= 0) and (hslSaturation <= 1) and
              (hslLightness >= 0) and (hslLightness <= 1);
end;

function IsValidColor(const Color: THSV): boolean;
begin
  with Color do
    result := (hsvHue >= 0) and (hsvHue < 360) and
              (hsvSaturation >= 0) and (hsvSaturation <= 1) and
              (hsvValue >= 0) and (hsvValue <= 1);
end;

function InvertColor(const Color: TColor): TColor;
begin
  result := ColorToRGB(Color) xor $FFFFFF;
end;

function InvertColor(const Color: TRGBQuad): TRGBQuad; overload;
begin
  result.rgbRed := 255 - Color.rgbRed;
  result.rgbGreen := 255 - Color.rgbGreen;
  result.rgbBlue := 255 - Color.rgbBlue;
end;

function InvertColor(const Color: TRGB): TRGB; overload;
begin
  result.rgbRed := 1 - Color.rgbRed;
  result.rgbGreen := 1 - Color.rgbGreen;
  result.rgbBlue := 1 - Color.rgbBlue;
end;

function EqualRGBQuad3(const Quad1: TRGBQuad; const Quad2: TRGBQuad): boolean;
begin
  EqualRGBQuad3 := (Quad1.rgbRed = Quad2.rgbRed) and
                   (Quad1.rgbGreen = Quad2.rgbGreen) and
                   (Quad1.rgbBlue = Quad2.rgbBlue);
end;

function EqualRGBQuad4(const Quad1: TRGBQuad; const Quad2: TRGBQuad): boolean;
var
  i1: cardinal absolute Quad1;
  i2: cardinal absolute Quad2;
begin
  EqualRGBQuad4 := i1 = i2;
end;

function Fix360(const a: Real): real;
begin
  result := a;
  if result > 360 then
    while result > 360 do
      result := result - 360
  else if result < 0 then
    while result < 0 do
      result := result + 360;
end;

function SameRGB(const AColor1, AColor2: TRGB): boolean;
begin
  result := SameValue(AColor1.rgbRed, AColor2.rgbRed) and
    SameValue(AColor1.rgbGreen, AColor2.rgbGreen) and
    SameValue(AColor1.rgbBlue, AColor2.rgbBlue);
end;

function SameHSV(const AColor1, AColor2: THSV): boolean;
begin
  result := SameValue(AColor1.hsvHue, AColor2.hsvHue) and
    SameValue(AColor1.hsvSaturation, AColor2.hsvSaturation) and
    SameValue(AColor1.hsvValue, AColor2.hsvValue);
end;

function CSSColorParse(const CSSColor: string): TColor;
var
  S: string;
  i: integer;
  v: integer;
begin
  S := CSSColor;
  for i := 0 to high(CSSColorNames) do
    if SameText(CSSColor, CSSColorNames[i, 0]) then
    begin
      S := CSSColorNames[i, 1];
      break;
    end;
  if (Length(S) = 7) and (S[1] = '#') and
    TryStrToInt('$' + Copy(S, 2), v) then
    result := ((v and $FF) shl 16) or (v and $FF00) or ((v and $FF0000) shr 16)
  else
    result := 0;
end;

function HexColorCodeToColor(const S: string): TColor;

  function TryStrToInt(const S: string; out i: byte): boolean;
  var
    int: integer;
  begin
    result := SysUtils.TryStrToInt(S, int);
    if result then
      i := int;
  end;

var
  rgbi: TRGBTriple;
begin
  result := clNone;
  if TryStrToInt('$' + Copy(S, 2, 2), rgbi.rgbtRed) and
    TryStrToInt('$' + Copy(S, 4, 2), rgbi.rgbtGreen) and
    TryStrToInt('$' + Copy(S, 6, 2), rgbi.rgbtBlue) then
    result := GetPascalColor(RGBTripleToRGB(rgbi));
end;

function ColorIsDark(AColor: TColor): boolean;
begin
  AColor := ColorToRGB(AColor);
  result := 0.299 * GetRValue(AColor) + 0.587 * GetGValue(AColor) + 0.114 * GetBValue(AColor) < 149;
end;

end.