lazarus-ccr/components/mbColorLib/RGBHSLUtils.pas

unit RGBHSLUtils;

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}

interface

uses
 {$IFDEF FPC}
 LCLIntf, LCLType,
 {$ELSE}
 Windows,
 {$ENDIF}
 Graphics, Math, Scanlines;

var //set these variables to your needs, e.g. 360, 255, 255
 MaxHue: integer = 239;
 MaxSat: integer = 240;
 MaxLum: integer = 240;

function HSLtoRGB (H, S, L: double): TColor;
function HSLRangeToRGB (H, S, L: integer): TColor;
procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer);
function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): integer;
procedure Clamp(var Input: integer; Min, Max: integer);
function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);

implementation

function HSLtoRGB(H, S, L: double): TColor;
var
 M1, M2: double;

  function HueToColorValue(Hue: double): byte;
  var
   V : double;
  begin
   if Hue < 0 then
    Hue := Hue + 1
   else
    if Hue > 1 then
     Hue := Hue - 1;
   if 6 * Hue < 1 then
    V := M1 + (M2 - M1) * Hue * 6
   else
    if 2 * Hue < 1 then
     V := M2
    else
     if 3 * Hue < 2 then
      V := M1 + (M2 - M1) * (2/3 - Hue) * 6
     else
      V := M1;
   Result := round (255 * V)
  end;

var
 R, G, B: byte;
begin
 if S = 0 then
  begin
   R := round (MaxLum * L);
   G := R;
   B := R
  end
 else
  begin
   if L <= 0.5 then
    M2 := L * (1 + S)
   else
    M2 := L + S - L * S;
   M1 := 2 * L - M2;
   R := HueToColorValue (H + 1/3);
   G := HueToColorValue (H);
   B := HueToColorValue (H - 1/3)
  end;
 Result := RGB (R, G, B)
end;

function HSLRangeToRGB(H, S, L : integer): TColor;
begin
 if s > MaxSat then s := MaxSat;
 if s < 0 then s := 0;
 if l > MaxLum then l := MaxLum;
 if l < 0 then l := 0;
 Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end;

procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1 : integer);
var
  R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
 H := h1;
 S := s1;
 L := l1;
 R := GetRValue (RGB) / 255;
 G := GetGValue (RGB) / 255;
 B := GetBValue (RGB) / 255;
 Cmax := Max (R, Max (G, B));
 Cmin := Min (R, Min (G, B));
 L := (Cmax + Cmin) / 2;
 if Cmax = Cmin then
  begin
   H := 0;
   S := 0;
  end
 else
  begin
   D := Cmax - Cmin;
   //calc L
   if L < 0.5 then
    S := D / (Cmax + Cmin)
   else
    S := D / (2 - Cmax - Cmin);
   //calc H
   if R = Cmax then
    H := (G - B) / D
   else
    if G = Cmax then
     H  := 2 + (B - R) /D
    else
     H := 4 + (R - G) / D;
   H := H / 6;
   if H < 0 then
    H := H + 1;
  end;
 H1 := round (H * MaxHue);
 S1 := round (S * MaxSat);
 L1 := round (L * MaxLum);
end;

function GetHValue(AColor: TColor): integer;
var
 d, h: integer;
begin
 RGBToHSLRange(AColor, h, d, d);
 Result := h;
end;

function GetSValue(AColor: TColor): integer;
var
 d, s: integer;
begin
 RGBToHSLRange(AColor, d, s, d);
 Result := s;
end;

function GetLValue(AColor: TColor): integer;
var
 d, l: integer;
begin
 RGBToHSLRange(AColor, d, d, l);
 Result := l;
end;

procedure Clamp(var Input: integer; Min, Max: integer);
begin
 if (Input < Min) then Input := Min;
 if (Input > Max) then Input := Max;
end;

function HSLToRGBTriple(H, S, L: integer): TRGBTriple;
const
  Divisor = 255*60;
var
  hTemp, f, LS, p, q, r: integer;
begin
  Clamp(H, 0, MaxHue);
  Clamp(S, 0, MaxSat);
  Clamp(L, 0, MaxLum);
  if (S = 0) then
    Result := RGBToRGBTriple(L, L, L)
  else
  begin
    hTemp := H mod MaxHue;
    f := hTemp mod 60;
    hTemp := hTemp div 60;
    LS := L*S;
    p := L - LS div MaxLum;
    q := L - (LS*f) div Divisor;
    r := L - (LS*(60 - f)) div Divisor;
    case hTemp of
      0: Result := RGBToRGBTriple(L, r, p);
      1: Result := RGBToRGBTriple(q, L, p);
      2: Result := RGBToRGBTriple(p, L, r);
      3: Result := RGBToRGBTriple(p, q, L);
      4: Result := RGBToRGBTriple(r, p, L);
      5: Result := RGBToRGBTriple(L, p, q);
    else
      Result  := RGBToRGBTriple(0, 0, 0);
    end;
  end;
end;

function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
const
 Divisor = 255*60;
var
 hTemp, f, LS, p, q, r: integer;
begin
 Clamp(H, 0, MaxHue);
 Clamp(S, 0, MaxSat);
 Clamp(L, 0, MaxLum);
 if (S = 0) then
   Result := RGBToRGBQuad(L, L, L)
 else
  begin
   hTemp := H mod MaxHue;
   f := hTemp mod 60;
   hTemp := hTemp div 60;
   LS := L*S;
   p := L - LS div MaxLum;
   q := L - (LS*f) div Divisor;
   r := L - (LS*(60 - f)) div Divisor;
   case hTemp of
    0: Result := RGBToRGBQuad(L, r, p);
    1: Result := RGBToRGBQuad(q, L, p);
    2: Result := RGBToRGBQuad(p, L, r);
    3: Result := RGBToRGBQuad(p, q, L);
    4: Result := RGBToRGBQuad(r, p, L);
    5: Result := RGBToRGBQuad(L, p, q);
   else
    Result  := RGBToRGBQuad(0, 0, 0);
   end;
  end;
end;

procedure RGBTripleToHSL(RGBTriple: TRGBTriple; var h, s, l: integer);

 function RGBMaxValue(RGB: TRGBTriple): byte;
 begin
  Result  := RGB.rgbtRed;
  if (Result < RGB.rgbtGreen) then Result := RGB.rgbtGreen;
  if (Result < RGB.rgbtBlue) then Result := RGB.rgbtBlue;
 end;

 function RGBMinValue(RGB: TRGBTriple) : byte;
 begin
  Result  := RGB.rgbtRed;
  if (Result > RGB.rgbtGreen) then Result := RGB.rgbtGreen;
  if (Result > RGB.rgbtBlue) then Result := RGB.rgbtBlue;
 end;
var
 Delta, Min: byte;
begin
 L     := RGBMaxValue(RGBTriple);
 Min   := RGBMinValue(RGBTriple);
 Delta := L-Min;
 if (L = Min) then
  begin
   H := 0;
   S := 0;
  end
 else
  begin
   S := MulDiv(Delta, 255, L);
   with RGBTriple do
    begin
     if (rgbtRed = L) then
      H := MulDiv(60, rgbtGreen-rgbtBlue, Delta)
     else
      if (rgbtGreen = L) then
       H := MulDiv(60, rgbtBlue-rgbtRed,   Delta) + 120
      else
       if (rgbtBlue = L) then
        H := MulDiv(60, rgbtRed-rgbtGreen,  Delta) + 240;
     if (H < 0) then H := H + 360;
    end;
  end;
end;

end.