hslcolors.pas

delphi 中用于 css 样式表的解析的类

unit HSLColors;

// Version 1.0
//
// The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except in compliance
// with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
// Software distributed under the License is distributed on an "AS IS" basis,
// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
// specific language governing rights and limitations under the License.
//
// The code is based on that found on:
//
// (in C) http://www.r2m.com/win-developer-faq/graphics/8.html
// (in Pascal) mailto:[e-mail]
// 
// Site: http://www.mythcode.org
// Author: Dzianis Koshkin
// E-mail: [e-mail]
//
// (C) 2005 MYTHcode.org

interface

uses
  Graphics, Math;

type

  TARGB = record
    R,G,B,A: Byte;
  end;

const

  HSLRange : Byte = 240;
  HSLUndef : Byte = 160;

function HSL_(H,S,L: Real): TColor; overload;
function HSL_(H,S,L: Byte): TColor; overload;

procedure _HSL(Color: TColor; var H,S,L: Real); overload;
procedure _HSL(Color: TColor; var H,S,L: Byte); overload;

implementation

function HSL_(H, S, L: Real): TColor;
var
  Color: TARGB absolute Result;
  M1,M2: Real;

function Hue_(Hue: Real) : Byte;
var
  V : Real;
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 S=0 then
  begin
    Color.R:=Round(255*L);
    Color.G:=Color.R;
    Color.B:=Color.R
  end else
  begin
    if L<=0.5
    then M2:=L*(1+S)
    else M2:=L+S-L*S;
    M1:=2*L-M2;
    Color.R:=Hue_(H + 1/3);
    Color.G:=Hue_(H);
    Color.B:=Hue_(H - 1/3)
  end;
end;

function HSL_(H, S, L : Byte): TColor;
begin
  Result:=HSL_(H/(HSLRange-1), S/HSLRange, L/HSLRange);
end;

// Convert RGB value(0-255 range) into HSL value(0-1 values)

procedure _HSL(Color: TColor; var H, S, L : Real);
var
  C: TARGB absolute Color;
  R,G,B,D, Cmax,Cmin: Real;

begin

  R:=C.R/255;
  G:=C.G/255;
  B:=C.B/255;

  Cmax:=Max(R,Max(G,B));
  Cmin:=Min(R,Min(G,B));

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

  if Cmax=Cmin then  // it's grey
  begin

    H:=0; // it's actually undefined
    S:=0;

  end else
  begin

    D:=Cmax-Cmin;

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

// calculate Hue
    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
end;

procedure _HSL(Color: TColor; var H, S, L : Byte);
var
  Hd,Sd,Ld: Real;
begin
  _HSL(Color, Hd, Sd, Ld);
  H:=Round(Hd*HSLRange); if H = 0 then H:=HSLUndef;
  S:=Round(Sd*HSLRange);
  L:=Round(Ld*HSLRange);
end;

end.