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

lcl: added RGB to HSV to RGB functions, issue #35112, from Alexey Tor.

Browse Source 
git-svn-id: trunk@60456 -
This commit is contained in:
mattias 2019-02-18 22:37:08 +00:00
parent 83a0bcaf59
commit 0de0d18fd0
1 changed files with 246 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

246
lcl/graphutil.pp
View File

@ -30,6 +30,21 @@ procedure RGBtoHLS(const R, G, B: Byte; out H, L, S: Byte);
function HLStoColor(const H, L, S: Byte): TColor; function HLStoColor(const H, L, S: Byte): TColor;
procedure HLStoRGB(const H, L, S: Byte; out R, G, B: Byte); procedure HLStoRGB(const H, L, S: Byte; out R, G, B: Byte);
// HSV functions are copied from mbColorLib without changes
procedure ColorToHSV(c: TColor; out H, S, V: Double);
function HSVToColor(H, S, V: Double): TColor;
procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);
procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer);
function HSVRangeToColor(H, S, V: Integer): TColor;
function HSVtoRGBTriple(H, S, V: integer): TRGBTriple;
function HSVtoRGBQuad(H, S, V: integer): TRGBQuad;
function GetHValue(Color: TColor): integer;
function GetSValue(Color: TColor): integer;
function GetVValue(Color: TColor): integer;
// specific things: // specific things:
{ Draw gradient from top to bottom with parabolic color grow } { Draw gradient from top to bottom with parabolic color grow }
@ -530,4 +545,235 @@ begin
end; end;
end; end;
function RGBtoRGBTriple(R, G, B: byte): TRGBTriple;
begin
with Result do
begin
rgbtRed := R;
rgbtGreen := G;
rgbtBlue := B;
end
end;
function RGBtoRGBQuad(R, G, B: byte): TRGBQuad;
begin
with Result do
begin
rgbRed := R;
rgbGreen := G;
rgbBlue := B;
rgbReserved := 0;
end
end;
function RGBTripleToColor(RGBTriple: TRGBTriple): TColor;
begin
Result := RGBTriple.rgbtBlue shl 16 + RGBTriple.rgbtGreen shl 8 + RGBTriple.rgbtRed;
end;
{ Assumes R, G, B to be in range 0..255. Calculates H, S, V in range 0..1
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c }
procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
var
rr, gg, bb: Double;
cmax, cmin, delta: Double;
begin
rr := R / 255;
gg := G / 255;
bb := B / 255;
cmax := MaxValue([rr, gg, bb]);
cmin := MinValue([rr, gg, bb]);
delta := cmax - cmin;
if delta = 0 then
begin
H := 0;
S := 0;
end else
begin
if cmax = rr then
H := (gg - bb) / delta + IfThen(gg < bb, 6, 0)
else if cmax = gg then
H := (bb - rr) / delta + 2
else if (cmax = bb) then
H := (rr -gg) / delta + 4;
H := H / 6;
S := delta / cmax;
end;
V := cmax;
end;
procedure ColorToHSV(c: TColor; out H, S, V: Double);
begin
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), H, S, V);
end;
{ Assumes H, S, V in the range 0..1 and calculates the R, G, B values which are
returned to be in the range 0..255.
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c
}
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
var
i: Integer;
f: Double;
p, q, t: Double;
procedure MakeRgb(rr, gg, bb: Double);
begin
R := Round(rr * 255);
G := Round(gg * 255);
B := Round(bb * 255);
end;
begin
i := floor(H * 6);
f := H * 6 - i;
p := V * (1 - S);
q := V * (1 - f*S);
t := V * (1 - (1 - f) * S);
case i mod 6 of
0: MakeRGB(V, t, p);
1: MakeRGB(q, V, p);
2: MakeRGB(p, V, t);
3: MakeRGB(p, q, V);
4: MakeRGB(t, p, V);
5: MakeRGB(V, p, q);
else MakeRGB(0, 0, 0);
end;
end;
function HSVToColor(H, S, V: Double): TColor;
var
r, g, b: Integer;
begin
HSVtoRGB(H, S, V, r, g, b);
Result := RgbToColor(r, g, b);
end;
procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer);
var
Delta, Min, H1, S1: double;
begin
Min := MinIntValue([R, G, B]);
V := MaxIntValue([R, G, B]);
Delta := V - Min;
if V = 0.0 then S1 := 0 else S1 := Delta / V;
if S1 = 0.0 then
H1 := 0
else
begin
if R = V then
H1 := 60.0 * (G - B) / Delta
else if G = V then
H1 := 120.0 + 60.0 * (B - R) / Delta
else if B = V then
H1 := 240.0 + 60.0 * (R - G) / Delta;
if H1 < 0.0 then H1 := H1 + 360.0;
end;
h := round(h1);
s := round(s1*255);
end;
procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer);
var
t: TRGBTriple;
begin
t := HSVtoRGBTriple(H, S, V);
R := t.rgbtRed;
G := t.rgbtGreen;
B := t.rgbtBlue;
end;
function HSVtoRGBTriple(H, S, V: integer): TRGBTriple;
const
divisor: integer = 255*60;
var
f, hTemp, p, q, t, VS: integer;
begin
if H > 360 then H := H - 360;
if H < 0 then H := H + 360;
if s = 0 then
Result := RGBtoRGBTriple(V, V, V)
else
begin
if H = 360 then hTemp := 0 else hTemp := H;
f := hTemp mod 60;
hTemp := hTemp div 60;
VS := V*S;
p := V - VS div 255;
q := V - (VS*f) div divisor;
t := V - (VS*(60 - f)) div divisor;
case hTemp of
0: Result := RGBtoRGBTriple(V, t, p);
1: Result := RGBtoRGBTriple(q, V, p);
2: Result := RGBtoRGBTriple(p, V, t);
3: Result := RGBtoRGBTriple(p, q, V);
4: Result := RGBtoRGBTriple(t, p, V);
5: Result := RGBtoRGBTriple(V, p, q);
else Result := RGBtoRGBTriple(0,0,0)
end;
end;
end;
function HSVtoRGBQuad(H, S, V: integer): TRGBQuad;
const
divisor: integer = 255*60;
var
f, hTemp, p, q, t, VS: integer;
begin
if H > 360 then H := H - 360;
if H < 0 then H := H + 360;
if s = 0 then
Result := RGBtoRGBQuad(V, V, V)
else
begin
if H = 360 then hTemp := 0 else hTemp := H;
f := hTemp mod 60;
hTemp := hTemp div 60;
VS := V*S;
p := V - VS div 255;
q := V - (VS*f) div divisor;
t := V - (VS*(60 - f)) div divisor;
case hTemp of
0: Result := RGBtoRGBQuad(V, t, p);
1: Result := RGBtoRGBQuad(q, V, p);
2: Result := RGBtoRGBQuad(p, V, t);
3: Result := RGBtoRGBQuad(p, q, V);
4: Result := RGBtoRGBQuad(t, p, V);
5: Result := RGBtoRGBQuad(V, p, q);
else Result := RGBtoRGBQuad(0,0,0)
end;
end;
end;
function HSVRangeToColor(H, S, V: integer): TColor;
begin
Result := RGBTripleToColor(HSVtoRGBTriple(H, S, V));
end;
function GetHValue(Color: TColor): integer;
var
s, v: integer;
begin
RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), Result, s, v);
end;
function GetSValue(Color: TColor): integer;
var
h, v: integer;
begin
RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, Result, v);
end;
function GetVValue(Color: TColor): integer;
var
h, s: integer;
begin
RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, s, Result);
end;
end. end.