unit HSLColors;
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;
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));
L:=(Cmax+Cmin)/2;
if Cmax=Cmin then begin
H:=0; S:=0;
end else
begin
D:=Cmax-Cmin;
if L < 0.5
then S:=D/(Cmax+Cmin)
else S:=D/(2-Cmax-Cmin);
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.