paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-09 14:35:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Improve conversion routines HLStoRGB and RGBtoHLS. Issue #28423, patch from Vojtech Cihak.

Browse Source 
git-svn-id: trunk@49592 -
This commit is contained in:
juha 2015-08-03 23:06:27 +00:00
parent 5f8660b1de
commit 43f03b0c5c
1 changed files with 63 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
lcl/graphutil.pp
View File

@ -106,102 +106,76 @@ begin
Result := R or (G shl 8) or (B shl 16); Result := R or (G shl 8) or (B shl 16);
end; end;
const
HUE_000 = 0;
HUE_060 = 43;
HUE_120 = 85;
HUE_180 = 128;
HUE_240 = 170;
HUE_300 = 213;
procedure RGBtoHLS(const R, G, B: Byte; out H, L, S: Byte); procedure RGBtoHLS(const R, G, B: Byte; out H, L, S: Byte);
var var aDelta, aMin, aMax: Byte;
cMax, cMin: Byte; // max and min RGB values
Rdelta, Gdelta, Bdelta: Byte; // intermediate value: % of spread from max
diff: Byte;
begin begin
// calculate lightness aMin := Math.min(Math.min(R, G), B);
cMax := MaxIntValue([R, G, B]); aMax := Math.max(Math.max(R, G), B);
cMin := MinIntValue([R, G, B]); aDelta := aMax - aMin;
L := (integer(cMax) + cMin + 1) div 2; if aDelta > 0 then
diff := cMax - cMin; begin
if aMax = B
if diff = 0 then H := round(170 + 42.5*(R - G)/aDelta) { 2*255/3; 255/6 }
then begin else if aMax = G
// r=g=b --> achromatic case then H := round(85 + 42.5*(B - R)/aDelta) { 255/3 }
S := 0; else if G >= B
H := 0; then H := round(42.5*(G - B)/aDelta)
end else H := round(255 + 42.5*(G - B)/aDelta);
else begin end;
// chromatic case L := (aMax + aMin) div 2;
// saturation if (L = 0) or (aDelta = 0)
if L <= 128 then S := 0
then S := integer(diff * 255) div (cMax + cMin) else if L <= 127
else S := integer(diff * 255) div (510 - cMax - cMin); then S := round(255*aDelta/(aMax + aMin))
else S := round(255*aDelta/(510 - aMax - aMin));
// hue
Rdelta := (cMax - R);
Gdelta := (cMax - G);
Bdelta := (cMax - B);
if R = cMax
then H := (HUE_000 + integer(Bdelta - Gdelta) * HUE_060 div diff) and $ff
else if G = cMax
then H := HUE_120 + integer(Rdelta - Bdelta) * HUE_060 div diff
else H := HUE_240 + integer(Gdelta - Rdelta) * HUE_060 div diff;
end;
end; end;
procedure HLStoRGB(const H, L, S: Byte; out R, G, B: Byte); procedure HLSToRGB(const H, L, S: Byte; out R, G, B: Byte);
var hue, chroma, x: Single;
// utility routine for HLStoRGB
function HueToRGB(const n1, n2: Byte; Hue: Integer): Byte;
begin
if Hue > 255
then Dec(Hue, 255)
else if Hue < 0
then Inc(Hue, 255);
// return r,g, or b value from this tridrant
case Hue of
HUE_000..HUE_060 - 1: Result := n1 + (n2 - n1) * Hue div HUE_060;
HUE_060..HUE_180 - 1: Result := n2;
HUE_180..HUE_240 - 1: Result := n1 + (n2 - n1) * (HUE_240 - Hue) div HUE_060;
else
Result := n1;
end;
end;
var
n1, n2: Byte;
begin begin
if S = 0 if S > 0 then
then begin begin { color }
// achromatic case hue:=6*H/255;
R := L; chroma := S*(1 - abs(0.0078431372549*L - 1)); { 2/255 }
G := L; G := trunc(hue);
B := L; B := L - round(0.5*chroma);
end x := B + chroma*(1 - abs(hue - 1 - G and 254));
else begin case G of
// chromatic case 0: begin
// set up magic numbers R := B + round(chroma);
if L < 128 G := round(x);
then begin end;
n2 := L + (L * S) div 255; 1: begin
n1 := 2 * L - n2; R := round(x);
end G := B + round(chroma);
else begin end;
n2 := S + L - (L * S) div 255; 2: begin
n1 := 2 * L - n2 - 1; R := B;
G := B + round(chroma);
B := round(x);
end;
3: begin
R := B;
G := round(x);
inc(B, round(chroma));
end;
4: begin
R := round(x);
G := B;
inc(B, round(chroma));
end;
otherwise
R := B + round(chroma);
G := B;
B := round(x);
end;
end else
begin { grey }
R := L;
G := L;
B := L;
end; end;
// get RGB
R := HueToRGB(n1, n2, H + HUE_120);
G := HueToRGB(n1, n2, H);
B := HueToRGB(n1, n2, H - HUE_120);
end;
end; end;