unit Couleur;

interface

uses windows,graphics, SysUtils;

type
  TTSL = record
    T : double; //Range is from 0 to 1
    S : double; //Range is from 0 to 1
    L : double; //Range is from 0 to 1
  end;
  TRVB = record
    R : byte; //Range is from 0 to 255
    V : byte; //Range is from 0 to 255
    B : byte; //Range is from 0 to 255
  end;
  TLAB = record
  end;
  //TSL in PhotoShop and may be in Adobe Products
  TTSV = record
    T : integer; //range is from 0..360°
    S : single;  //range is from 0..100%  where 0 is white and 100% is no saturation.
    V : single;  //range is from 0..100%
  end;
  //TSL used in Paint Shop Pro software
  TTSLPSP=record
    T : byte;  // Range is from 0.255
    S : byte;  // Range is from 0.255
    L : byte;  // Range is from 0.255
  end;

  TCouleur = class
    private
      FRVB : TRVB;
      FTSL : TTSL;
      FTSV : TTSV;
      FTSLPSP : TTSLPSP;
      FColor : TColor;
      FHTML : string;
      function RVBToTColor(Value :TRVB):TColor;
      function TColorToRVB(Coul :TColor):TRVB;

      function TSVToRVB(const Value: TTSV):TRVB;
      function RVBToTSV(const Value: TRVB):TTSV;

      function TSLToTColor (Value: TTSL): TColor;
      function TSLToRVB (Value: TTSL): TRVB;

      function TColorToTSL (Coul: TColor) : TTSL;
      function RVBToTSL (Value: TRVB):TTSL;

      function TSLToTSLPSP:TTSLPSP;
      function TSLPSPToTSL:TTSL;

      function TColorToHTML(Value : TColor) : string;

      procedure SetRVB(const Value: TRVB);
      procedure SetTSL(const Value: TTSL);
      procedure SetTSLPSP(const Value: TTSLPSP);
      procedure SetTSV(const Value: TTSV);
      procedure SetColor(const Value: TColor);
      procedure SetHTML(const Value: string);
    protected
    public
      constructor Create;
      destructor Destroy;override;
      procedure Assign(const Value : TCouleur);
    published
      property HTML : string read FHTML write SetHTML;
      property RVB : TRVB read FRVB write SetRVB;
      property TSL : TTSL read FTSL write SetTSL;
      property TSV : TTSV read FTSV write SetTSV;
      property TSLPSP : TTSLPSP read FTSLPSP write SetTSLPSP;
      property Color : TColor read FColor write SetColor;
  end;

implementation

uses Math;

{ TCouleur }
function TCouleur.RVBToTColor(Value: TRVB): TColor;
begin
  result := RGB(Value.R,Value.V,Value.B);
end;

function TCouleur.RVBToTSL(Value: TRVB): TTSL;
var
  R,
  G,
  B,
  D,
  Cmax,
  Cmin: double;

begin
  R := Value.R / 255;
  G := Value.V / 255;
  B := Value.B / 255;
  Cmax := Max (R, Max (G, B));
  Cmin := Min (R, Min (G, B));

// calculate luminosity
  Result.L := (Cmax + Cmin) / 2;

  if Cmax = Cmin then  // it's grey
  begin
    Result.T := 0; // it's actually undefined
    Result.S := 0
  end else begin
    D := Cmax - Cmin;

// calculate Saturation
    if Result.L < 0.5 then
      Result.S := D / (Cmax + Cmin)
    else
      Result.S := D / (2 - Cmax - Cmin);

// calculate Hue
    if R = Cmax then
      Result.T := (G - B) / D
    else
      if G = Cmax then
        Result.T  := 2 + (B - R) /D
      else
        Result.T := 4 + (R - G) / D;

    Result.T := Result.T / 6;
    if Result.T < 0 then
      Result.T := Result.T + 1
  end
end;

function TCouleur.RVBToTSV(const Value: TRVB): TTSV;
var
  RGB: array[0..2] of Single;
  MinIndex, MaxIndex: Integer;
  Range: Single;
  T : single;
begin
  RGB[0]:= Value.R;
  RGB[1]:= Value.V;
  RGB[2]:= Value.B;

  MinIndex:= 0;
  if Value.V < Value.R then
    MinIndex:= 1;

  if Value.B < RGB[MinIndex] then
    MinIndex:= 2;

  MaxIndex:= 0;
  if Value.V > Value.R then
    MaxIndex:= 1;

  if Value.B > RGB[MaxIndex] then
    MaxIndex:= 2;

  Range:= RGB[MaxIndex] - RGB[MinIndex];

  // Check for a gray level
  if Range = 0 then
  begin
    Result.T:= FTSV.T; // Can't determine on greys, so set to -1  //Changement de Nico Default = -1
    Result.S:= 0; // Gray is at the center;
    Result.V:= 100*Value.R/255; // could choose R, G, or B because they are all the same value.
  end
  else
  begin
    T:= MaxIndex*2 + (Value.R-Value.V)/Range;
    Result.S:= (Range/RGB[MaxIndex])*100;
    Result.V:= 100*(RGB[MaxIndex]/255);
    T:= T/6;
    if T < 0 then
      T:= 1 + T;
    Result.T := Round(T*359);
  end;
end;

function TCouleur.TColorToRVB(Coul: TColor): TRVB;
begin
  Result.R := Coul and $FF;
  Result.V := (Coul shr 8)  and $FF;
  Result.B := (Coul shr 16) and $FF;
end;

function TCouleur.TColorToTSL(Coul: TColor): TTSL;
begin
//TODO Mettre du Code
//  Result := RVBToTColor(RGBToTSL();

end;

function TCouleur.TSLToRVB(Value: TTSL): TRVB;
var
  M1,
  M2: double;

  function HueToColourValue (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;

begin
  if Value.S = 0 then
  begin
    Result.R := round (255 * Value.L);
    Result.V := Result.R;
    Result.B := Result.R
  end else begin
    if Value.L <= 0.5 then
      M2 := Value.L * (1 + Value.S)
    else
      M2 := Value.L + Value.S - Value.L * Value.S;
    M1 := 2 * Value.L - M2;
    Result.R := HueToColourValue (Value.T + 1/3);
    Result.V := HueToColourValue (Value.T);
    Result.B := HueToColourValue (Value.T - 1/3)
  end;
end;

function TCouleur.TSLToTColor(Value: TTSL): TColor;
var
  RVB : TRVB;
begin
  RVB := TSLToRVB(Value);
  Result := RGB (RVB.R, RVB.V, RVB.B)
end;

function TCouleur.TSVToRVB(const Value: TTSV): TRVB;
const 
  SectionSize = 60/360; 
var 
  Section: Single; 
  SectionIndex: Integer; 
  f: single; 
  p, q, t: Single;
  H,S,V : single; 
begin
  H := Value.T/360;
  S := Value.S/100;
  V := (255*Value.V/100);
  //if H < 0 then
  if (S=0) then
  begin
    Result.R:= round(V);//round(255*V/100);
    Result.V:= Result.R;
    Result.B:= Result.R;
  end 
  else 
  begin 
    Section:= H/SectionSize; 
    SectionIndex:= Floor(Section); 
    f:= Section - SectionIndex; 
    p:= V * ( 1 - S ); 
    q:= V * ( 1 - S * f ); 
    t:= V * ( 1 - S * ( 1 - f ) ); 
    case SectionIndex of 
      0:
        begin 
          Result.R:= round(V);
          Result.V:= round(t);
          Result.B:= round(p);
        end;
      1:
        begin
          Result.R:= round(q);
          Result.V:= round(V);
          Result.B:= round(p);
        end;
      2:
        begin
          Result.R:= round(p);
          Result.V:= round(V);
          Result.B:= round(t);
        end;
      3:
        begin
          Result.R:= round(p);
          Result.V:= round(q);
          Result.B:= round(V);
        end;
      4:
        begin
          Result.R:= round(t);
          Result.V:= round(p);
          Result.B:= round(V);
        end;
    else
      Result.R:= round(V);
      Result.V:= round(p);
      Result.B:= round(q);
    end;
  end;
end;

function TCouleur.TSLToTSLPSP: TTSLPSP;
begin
  Result.T := round(FTSL.T*255);
  Result.S := round(FTSL.S*255);
  Result.L := round(FTSL.L*255);
end;

function TCouleur.TSLPSPToTSL: TTSL;
begin
  Result.T := FTSLPSP.T/255;
  Result.S := FTSLPSP.S/255;
  Result.L := FTSLPSP.L/255;
end;

constructor TCouleur.Create;
begin
  inherited;
end;

destructor TCouleur.Destroy;
begin

  inherited;
end;

procedure TCouleur.SetRVB(const Value: TRVB);
begin
  FRVB := Value;
  FTSL := RVBToTSL(FRVB);
  FTSV := RVBToTSV(FRVB);
  if FTSV.S <>0 then
    FTSV.T := round(FTSL.T*359);
  FTSLPSP := TSLToTSLPSP();
  FColor := RVBToTColor(FRVB);
  FHTML:= TColorToHTML(FColor);
end;

procedure TCouleur.SetTSL(const Value: TTSL);
begin
  FTSL := Value;
  FRVB := TSLToRVB(FTSL);
  FTSV := RVBToTSV(FRVB);
  if FTSV.S <>0 then
    FTSV.T := round(FTSL.T*359);
  FTSLPSP := TSLToTSLPSP();
  FColor := RVBToTColor(FRVB);
  FHTML:= TColorToHTML(FColor);
end;

procedure TCouleur.SetTSLPSP(const Value: TTSLPSP);
begin
  FTSLPSP := Value;
  FTSL := TSLPSPToTSL;
  FRVB := TSLToRVB(FTSL);
  FTSV := RVBToTSV(FRVB);
  if FTSV.S <>0 then
    FTSV.T := round(FTSL.T*359);
  FColor := RVBToTColor(FRVB);
  FHTML:= TColorToHTML(FColor);
end;

procedure TCouleur.SetTSV(const Value: TTSV);
begin
  FTSV := Value;
  FRVB := TSVToRVB(FTSV);
  FTSL := RVBToTSL(FRVB);
  FTSLPSP := TSLToTSLPSP();
  FColor := RVBToTColor(FRVB);
  FHTML:= TColorToHTML(FColor);
end;

procedure TCouleur.SetColor(const Value: TColor);
begin
  FColor := Value;
  FRVB := TColorToRVB(FColor);
  FTSL := RVBToTSL(FRVB);
  FTSLPSP := TSLToTSLPSP();
  FTSV := RVBToTSV(FRVB);
  if FTSV.S <>0 then
    FTSV.T := round(FTSL.T*359);
  FHTML:= TColorToHTML(FColor);
end;

procedure TCouleur.Assign(const Value: TCouleur);
begin
  FRVB := Value.FRVB;
  FTSL := Value.FTSL;
  FTSV := Value.FTSV;
  FTSLPSP := Value.FTSLPSP;
  FColor := Value.FColor;
  FHTML := Value.FHTML;
end;

procedure TCouleur.SetHTML(const Value: string);
begin
  FHTML := Value;
end;

function TCouleur.TColorToHTML(Value: TColor): string;
  function Swap(Color: TColor): TColor;
  begin
    Result :=
      Color and $FF0000 shr 16 +
      Color and $00FF00 +
      Color and $0000FF shl 16;
  end;
begin
  Result := IntToHex(Swap(FColor),6);
end;

end.
