1
0
Files
aarre
applications
bindings
components
Comba_Animation
aboutcomponent
acs
beepfp
callite
chelper
chemtext
cmdline
cmdlinecfg
colorpalette
cryptini
csvdocument
epiktimer
extrasyn
fpexif
fpsound
fpspreadsheet
fractions
freetypepascal
geckoport
gradcontrols
grid_semaphor
industrialstuff
iosdesigner
iphonelazext
jujiboutils
jvcllaz
kcontrols
lazautoupdate
lazbarcodes
lazmapviewer
lclextensions
longtimer
manualdock
mbColorLib
examples
BAxisColorPicker.pas
BColorPicker.pas
CColorPicker.pas
CIEAColorPicker.pas
CIEBColorPicker.pas
CIELColorPicker.pas
GAxisColorPicker.pas
GColorPicker.pas
HColorPicker.pas
HRingPicker.pas
HSCirclePicker.pas
HSColorPicker.pas
HSLColorPicker.pas
HSLRingPicker.pas
HTMLColors.pas
HexaColorPicker.pas
KColorPicker.pas
LVColorPicker.pas
MColorPicker.pas
OfficeMoreColorsDialog.lfm
OfficeMoreColorsDialog.pas
PalUtils.pas
PickCursor.res
RAxisColorPicker.pas
RColorPicker.pas
RGBCIEUtils.pas
RGBCMYKUtils.pas
RGBHSLUtils.pas
RGBHSVUtils.pas
Readme.rtf
SColorPicker.pas
SLColorPicker.pas
SLHColorPicker.pas
Scanlines.pas
ScreenWin.lfm
ScreenWin.pas
SelPropUtils.pas
XPLibIntegration.txt
YColorPicker.pas
clean.bat
clear history.bat
mbBasicPicker.pas
mbColorLibD10.dpk
mbColorLibD5.dpk
mbColorLibD7.dpk
mbColorLibD9.dpk
mbColorList.pas
mbColorPalette.pas
mbColorPickerControl.pas
mbColorPreview.pas
mbColorTree.pas
mbDeskPickerButton.pas
mbOfficeColorDialog.pas
mbReg.lrs
mbReg.pas
mbTrackBarPicker.pas
mbcolorconv.pas
mbcolorliblaz.lpk
mbutils.pas
mxs.inc
readme.txt
mplayer
multithreadprocs
nvidia-widgets
onguard
orpheus
playsoundpackage
poweredby
powerpdf
rgbgraphics
richmemo
richview
rtfview
rx
scrolltext
smnetgradient
spktoolbar
svn
systools
tdi
thtmlport
tparadoxdataset
tvplanit
xdev_toolkit
zlibar
zmsql
examples
image_sources
lclbindings
wst
lazarus-ccr/components/mbColorLib/RGBHSLUtils.pas

395 lines
8.5 KiB
ObjectPascal
Raw Normal View History

unit RGBHSLUtils;
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
interface
uses
LCLIntf, LCLType, Graphics, Math, Scanlines;
var //set these variables to your needs, e.g. 360, 255, 255
MaxHue: integer = 359;
MaxSat: integer = 240;
MaxLum: integer = 240;
{function HSLtoRGB(H, S, L: double): TColor;}
function HSLRangeToRGB(H, S, L: integer): TColor;
{procedure ColorToHSL(AColor: TColor; var H, S, L: Double);}
function HSLtoColor(H, S, L: Double): TColor;
{procedure RGBtoHSL(RGB: TColor; out H, S, L: Double); }
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): 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
uses
mbUtils;
(*
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function RGBMaxValue(r, g, b: Double): Double;
begin
Result := r;
if (Result < g) then Result := g;
if (Result < b) then Result := b;
end;
function RGBMinValue(r, g, b: Double): Double;
begin
Result := r;
if (Result > g) then Result := g;
if (Result > b) then Result := b;
end;
var
r, g, b: Double;
delta, min: Double;
begin
r := GetRValue(AColor)/255;
g := GetGValue(AColor)/255;
b := GetBValue(AColor)/255;
L := RGBMaxValue(r, g, b);
min := RGBMinValue(r, g, b);
delta := L - min;
if (L = min) then
begin
H := 0.0;
S := 0.0;
end
else
begin
S := delta / L;
if r = L then
H := 60 * (g - b)/delta
else if g = L then
H := 60 * (b - r)/delta + 120
else if b = L then
H := 60 * (r - g)/delta + 240;
if H < 0 then H := H + 360;
H := H / 360;
end;
end; *)
function HSLtoColor(H, S, L: Double): TColor;
const
Divisor = 255*60;
var
hTemp, f, LS, p, q, r: integer;
intH, intS, intL: Integer;
begin
intH := round(H*360);
intS := round(S*255);
intL := round(L*255);
if intH > 360 then dec(intH, 360);
if intH < 0 then inc(intH, 360);
Clamp(intS, 0, 255);
Clamp(intL, 0, 255);
if (intS = 0) then
Result := RGBtoColor(intL, intL, intL)
else
begin
hTemp := intH mod 360;
f := hTemp mod 60;
hTemp := hTemp div 60;
LS := intL * intS;
p := intL - LS div 255;
q := intL - (LS*f) div Divisor;
r := intL - (LS*(60 - f)) div Divisor;
case hTemp of
0: Result := RGBtoColor(intL, r, p);
1: Result := RGBtoColor(q, intL, p);
2: Result := RGBtoColor(p, intL, r);
3: Result := RGBtoColor(p, q, intL);
4: Result := RGBtoColor(r, p, intL);
5: Result := RGBtoColor(intL, p, q);
else
Result := RGBtoColor(0, 0, 0);
end;
end;
end;
// =============================================================================
function HSLtoRGB(H, S, L: double): TColor;
var
M1, M2: double;
function HueToColorValue(Hue: double): byte;
var
V : double;
begin
if Hue > 10 then
Hue := Hue + 1;
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(255 * 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
Clamp(H, 0, MaxHue);
Clamp(S, 0, MaxSat);
Clamp(L, 0, MaxLum);
Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end;
//==============================================================================
procedure RGBtoHSL(RGB: TColor; out H, S, L: Double);
var
R, G, B, D, Cmax, Cmin: double;
begin
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 S
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;
end;
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
var
R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
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;
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.