From 8763264447c2098517b9636d165cc1c8e04999f0 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 17 Dec 2016 21:35:57 +0000 Subject: [PATCH] mbColorLib: Beginning to add MaxHue, MaxSaturation and MaxValue properties to HSV ColorPickers git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5535 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/mbColorLib/HColorPicker.pas | 167 ++++++++++++++++-------- components/mbColorLib/RGBHSVUtils.pas | 82 +++++++----- components/mbColorLib/SColorPicker.pas | 148 ++++++++++++++------- components/mbColorLib/SLColorPicker.pas | 8 +- components/mbColorLib/Scanlines.pas | 4 +- components/mbColorLib/VColorPicker.pas | 148 ++++++++++++++------- 6 files changed, 375 insertions(+), 182 deletions(-) diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas index 43ce90bab..588f8a58f 100644 --- a/components/mbColorLib/HColorPicker.pas +++ b/components/mbColorLib/HColorPicker.pas @@ -18,14 +18,21 @@ uses type THColorPicker = class(TmbTrackBarPicker) private - FVal, FSat, FHue: integer; + FVal, FSat, FHue: double; + FMaxVal, FMaxSat, FMaxHue: Integer; function ArrowPosFromHue(h: integer): integer; function HueFromArrowPos(p: integer): integer; + function GetHue: Integer; + function GetSat: Integer; + function GetVal: Integer; function GetSelectedColor: TColor; procedure SetSelectedColor(c: TColor); procedure SetHue(h: integer); + procedure SetMaxHue(h: Integer); + procedure SetMaxSat(s: Integer); + procedure SetMaxVal(v: Integer); procedure SetSat(s: integer); - procedure SetValue(v: integer); + procedure SetVal(v: integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; @@ -34,9 +41,12 @@ type public constructor Create(AOwner: TComponent); override; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 255; - property Value: integer read FVal write SetValue default 255; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; + property Value: integer read GetVal write SetVal; + property MaxHue: Integer read FMaxHue write SetMaxHue default 359; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxValue: Integer read FMaxVal write SetMaxVal default 255; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; end; @@ -51,11 +61,13 @@ uses constructor THColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 360; + FMaxHue := 359; + FMaxSat := 255; + FMaxVal := 255; + FGradientWidth := FMaxHue + 1; FGradientHeight := 12; - FSat := 255; - FVal := 255; - FArrowPos := ArrowPosFromHue(0); + FSat := 1.0; + FVal := 1.0; FChange := false; SetHue(0); HintFormat := 'Hue: %value (selected)'; @@ -64,30 +76,35 @@ begin end; function THColorPicker.GetGradientColor(AValue: Integer): TColor; +var + h: Double; begin - if Layout = lyVertical then AValue := 360 - AValue; - Result := HSVtoColor(AValue, FSat, FVal); + if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue; + h := AValue / (FMaxHue + 1); + Result := HSVtoColor(h, FSat, FVal); end; -procedure THColorPicker.SetValue(v: integer); +function THColorPicker.GetHue: Integer; begin - Clamp(v, 0, 255); - if FVal <> v then - begin - FVal := v; - FManual := false; - CreateGradient; - Invalidate; - if FChange and Assigned(OnChange) then OnChange(Self); - end; + Result := round(FHue * FMaxHue); +end; + +function THColorPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function THColorPicker.GetVal: Integer; +begin + Result := round(FVal * FMaxVal); end; procedure THColorPicker.SetHue(h: integer); begin - Clamp(h, 0, 360); - if FHue <> h then + Clamp(h, 0, FMaxHue); + if GetHue <> h then begin - FHue := h; + FHue := h / FMaxHue; FArrowPos := ArrowPosFromHue(h); FManual := false; Invalidate; @@ -95,12 +112,56 @@ begin end; end; +procedure THColorPicker.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + FGradientWidth := FMaxHue + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure THColorPicker.SetMaxSat(s: Integer); +begin + if s = FMaxSat then + exit; + FMaxSat := s; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure THColorPicker.SetMaxVal(v: Integer); +begin + if v = FMaxVal then + exit; + FMaxVal := v; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + procedure THColorPicker.SetSat(s: integer); begin - Clamp(s, 0, 255); - if FSat <> s then + Clamp(s, 0, FMaxSat); + if GetSat() <> s then begin - FSat := s; + FSat := s / FMaxSat; + FManual := false; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); + end; +end; + +procedure THColorPicker.SetVal(v: integer); +begin + Clamp(v, 0, FMaxVal); + if GetVal() <> v then + begin + FVal := v / FMaxVal; FManual := false; CreateGradient; Invalidate; @@ -114,12 +175,12 @@ var begin if Layout = lyHorizontal then begin - a := Round(((Width - 12)/360)*h); + a := Round((Width - 12) * h / FMaxHue); if a > Width - FLimit then a := Width - FLimit; end else begin - a := Round(((Height - 12)/360)*h); + a := Round((Height - 12) * h / FMaxHue); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -131,24 +192,23 @@ var r: integer; begin if Layout = lyHorizontal then - r := Round(p/((Width - 12)/360)) + r := Round(p / (Width - 12) * FMaxHue) else - r := Round(p/((Height - 12)/360)); - Clamp(r, 0, 360); + r := Round(p / (Height - 12) * MaxHue); + Clamp(r, 0, FMaxHue); Result := r; end; function THColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := HSVtoColor(FHue, FSat, FVal) - else - Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); + Result := HSVtoColor(FHue, FSat, FVal); + if WebSafe then + Result := GetWebSafe(Result); end; function THColorPicker.GetSelectedValue: integer; begin - Result := FHue; + Result := GetHue(); end; procedure THColorPicker.SetSelectedColor(c: TColor); @@ -156,11 +216,11 @@ var h, s, v: integer; begin if WebSafe then c := GetWebSafe(c); - RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); + RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); FChange := false; SetHue(h); SetSat(s); - SetValue(v); + SetVal(v); FManual := false; FChange := true; if Assigned(OnChange) then OnChange(Self); @@ -168,40 +228,43 @@ end; function THColorPicker.GetArrowPos: integer; begin - Result := ArrowPosFromHue(FHue); + if FMaxHue = 0 then + Result := inherited GetArrowPos + else + Result := ArrowPosFromHue(GetHue()); end; procedure THColorPicker.Execute(tbaAction: integer); begin case tbaAction of TBA_Resize: - SetHue(FHue); + SetHue(GetHue); TBA_MouseMove: - FHue := HueFromArrowPos(FArrowPos); + Hue := HueFromArrowPos(FArrowPos); TBA_MouseDown: - FHue := HueFromArrowPos(FArrowPos); + Hue := HueFromArrowPos(FArrowPos); TBA_MouseUp: - FHue := HueFromArrowPos(FArrowPos); + Hue := HueFromArrowPos(FArrowPos); TBA_WheelUp: - SetHue(FHue + Increment); + SetHue(GetHue() + Increment); TBA_WheelDown: - SetHue(FHue - Increment); + SetHue(GetHue() - Increment); TBA_VKLeft: - SetHue(FHue - Increment); + SetHue(GetHue() - Increment); TBA_VKCtrlLeft: SetHue(0); TBA_VKRight: - SetHue(FHue + Increment); + SetHue(GetHue() + Increment); TBA_VKCtrlRight: - SetHue(360); + SetHue(FMaxHue); TBA_VKUp: - SetHue(FHue - Increment); + SetHue(GetHue() - Increment); TBA_VKCtrlUp: SetHue(0); TBA_VKDown: - SetHue(FHue + Increment); + SetHue(GetHue() + Increment); TBA_VKCtrlDown: - SetHue(360); + SetHue(FMaxHue); else inherited; end; diff --git a/components/mbColorLib/RGBHSVUtils.pas b/components/mbColorLib/RGBHSVUtils.pas index 38fad1c5c..8bba05980 100644 --- a/components/mbColorLib/RGBHSVUtils.pas +++ b/components/mbColorLib/RGBHSVUtils.pas @@ -14,46 +14,26 @@ uses {$ENDIF} SysUtils, Classes, Graphics, Math, Scanlines; -function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; -function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; -function RGBTripleToColor(Triple: TRGBTriple): TColor; -procedure RGBToHSV(R,G,B: integer; var H,S,V: integer); +procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double); +procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer); + +procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer); +procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer); + function HSVtoRGBTriple(H, S, V: integer): TRGBTriple; function HSVtoRGBQuad(H, S, V: integer): TRGBQuad; -function HSVtoColor(H, S, V: integer): TColor; + +function HSVtoColor(H, S, V: Double): TColor; +function HSVRangeToColor(H, S, V: Integer): TColor; + function GetHValue(Color: TColor): integer; function GetVValue(Color: TColor): integer; function GetSValue(Color: TColor): integer; + implementation -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(Triple: TRGBTriple): TColor; -begin - Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue); -end; - -procedure RGBToHSV(R, G, B: integer; var H, S, V: integer); +procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer); var Delta, Min, H1, S1: double; begin @@ -79,6 +59,31 @@ begin s := round(s1*255); end; +procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double); +var + hh, ss, vv: Integer; +begin + RGBtoHSVRange(R, G, B, hh, ss, vv); + H := H / 360; + S := S / 255; + V := V / 255; +end; + +procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer); +begin + HSVtoRGBRange(round(H*360), round(S*255), round(V*255), R, G, B); +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; @@ -141,30 +146,35 @@ begin end; end; -function HSVtoColor(H, S, V: integer): TColor; +function HSVRangetoColor(H, S, V: integer): TColor; begin Result := RGBTripleToColor(HSVtoRGBTriple(H, S, V)); end; +function HSVtoColor(H, S, V: Double): TColor; +begin + Result := HSVRangeToColor(round(H*360), round(S*255), round(V*255)); +end; + function GetHValue(Color: TColor): integer; var s, v: integer; begin - RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), Result, s, v); + RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), Result, s, v); end; function GetSValue(Color: TColor): integer; var h, v: integer; begin - RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, Result, v); + RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, Result, v); end; function GetVValue(Color: TColor): integer; var h, s: integer; begin - RGBToHSV(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, s, Result); + RGBToHSVRange(GetRValue(Color), GetGValue(Color), GetBValue(Color), h, s, Result); end; end. diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas index d5007b308..c4e474b85 100644 --- a/components/mbColorLib/SColorPicker.pas +++ b/components/mbColorLib/SColorPicker.pas @@ -18,14 +18,21 @@ uses type TSColorPicker = class(TmbTrackBarPicker) private - FVal, FHue, FSat: integer; + FVal, FHue, FSat: Double; + FMaxVal, FMaxHue, FMaxSat: Integer; function ArrowPosFromSat(s: integer): integer; function SatFromArrowPos(p: integer): integer; + function GetHue: Integer; + function GetSat: Integer; + function GetVal: Integer; function GetSelectedColor: TColor; procedure SetSelectedColor(c: TColor); procedure SetHue(h: integer); procedure SetSat(s: integer); procedure SetValue(v: integer); + procedure SetMaxHue(h: Integer); + procedure SetMaxSat(s: Integer); + procedure SetMaxVal(v: Integer); protected procedure Execute(tbaAction: integer); override; function GetArrowPos: integer; override; @@ -34,9 +41,12 @@ type public constructor Create(AOwner: TComponent); override; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 255; - property Value: integer read FVal write SetValue default 255; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; + property Value: integer read GetVal write SetValue; + property MaxHue: Integer read FMaxHue write SetMaxHue default 359; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxValue: Integer read FMaxVal write SetMaxVal default 255; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; end; @@ -51,13 +61,15 @@ uses constructor TSColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 256; + FMaxHue := 359; + FMaxSat := 255; + FMaxVal := 255; + FGradientWidth := FMaxSat + 1; FGradientHeight := 12; - FHue := 0; - FVal := 255; - FArrowPos := ArrowPosFromSat(0); FChange := false; - SetSat(255); + FHue := 0; + FVal := 1.0; + SetSat(FMaxSat); HintFormat := 'Saturation: %value (selected)'; FManual := false; FChange := true; @@ -111,15 +123,15 @@ end; function TSColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := HSVtoColor(FHue, AValue, FVal); + Result := HSVtoColor(FHue, AValue/FMaxSat, FVal); end; procedure TSColorPicker.SetValue(v: integer); begin - Clamp(v, 0, 255); - if FVal <> v then + Clamp(v, 0, FMaxVal); + if GetVal() <> v then begin - FVal := v; + FVal := v / FMaxVal; FManual := false; CreateGradient; Invalidate; @@ -129,10 +141,10 @@ end; procedure TSColorPicker.SetHue(h: integer); begin - Clamp(h, 0, 360); - if FHue <> h then + Clamp(h, 0, FMaxHue); + if GetHue() <> h then begin - FHue := h; + FHue := h / FMaxHue; CreateGradient; FManual := false; Invalidate; @@ -142,10 +154,10 @@ end; procedure TSColorPicker.SetSat(s: integer); begin - Clamp(s, 0, 255); - if FSat <> s then + Clamp(s, 0, FMaxSat); + if GetSat() <> s then begin - FSat := s; + FSat := s / FMaxSat; FManual := false; FArrowPos := ArrowPosFromSat(s); Invalidate; @@ -159,13 +171,13 @@ var begin if Layout = lyHorizontal then begin - a := Round(((Width - 12)/255)*s); + a := Round(s / FMaxSat * (Width - 12)); if a > Width - FLimit then a := Width - FLimit; end else begin - s := 255 - s; - a := Round(((Height - 12)/255)*s); + s := FMaxSat - s; + a := Round(s / FMaxSat * (Height - 12)); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -177,24 +189,69 @@ var r: integer; begin if Layout = lyHorizontal then - r := Round(p/((Width - 12)/255)) + r := Round(p / (Width - 12) * FMaxSat) else - r := Round(255 - p/((Height - 12)/255)); - Clamp(r, 0, 255); + r := Round(FMaxSat - p / (Height - 12) * FMaxSat); + Clamp(r, 0, FMaxSat); Result := r; end; +function TSColorPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function TSColorPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function TSColorPicker.GetVal: Integer; +begin + Result := round(FVal * FMaxVal); +end; + +procedure TSColorPicker.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TSColorPicker.SetMaxSat(s: Integer); +begin + if s = FMaxSat then + exit; + FMaxSat := s; + FGradientWidth := FMaxSat + 1; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + +procedure TSColorPicker.SetMaxVal(v: Integer); +begin + if v = FMaxVal then + exit; + FMaxVal := v; + CreateGradient; + if FChange and Assigned(OnChange) then OnChange(Self); + Invalidate; +end; + function TSColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := HSVtoColor(FHue, FSat, FVal) - else - Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); + Result := HSVToColor(FHue, FSat, FVal); + if WebSafe then + Result := GetWebSafe(Result); end; function TSColorPicker.GetSelectedValue: integer; begin - Result := FSat; + Result := GetSat(); end; procedure TSColorPicker.SetSelectedColor(c: TColor); @@ -202,7 +259,7 @@ var h, s, v: integer; begin if WebSafe then c := GetWebSafe(c); - RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); + RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); FChange := false; SetHue(h); SetSat(s); @@ -214,38 +271,41 @@ end; function TSColorPicker.GetArrowPos: integer; begin - Result := ArrowPosFromSat(FSat); + if FMaxSat = 0 then + Result := inherited GetArrowPos + else + Result := ArrowPosFromSat(GetSat()); end; procedure TSColorPicker.Execute(tbaAction: integer); begin case tbaAction of TBA_Resize: - SetSat(FSat); + SetSat(GetSat()); TBA_MouseMove: - FSat := SatFromArrowPos(FArrowPos); + SetSat(SatFromArrowPos(FArrowPos)); TBA_MouseDown: - FSat := SatFromArrowPos(FArrowPos); + SetSat(SatFromArrowPos(FArrowPos)); TBA_MouseUp: - FSat := SatFromArrowPos(FArrowPos); + SetSat(SatFromArrowPos(FArrowPos)); TBA_WheelUp: - SetSat(FSat + Increment); + SetSat(GetSat() + Increment); TBA_WheelDown: - SetSat(FSat - Increment); + SetSat(GetSat() - Increment); TBA_VKLeft: - SetSat(FSat - Increment); + SetSat(GetSat() - Increment); TBA_VKCtrlLeft: SetSat(0); TBA_VKRight: - SetSat(FSat + Increment); + SetSat(GetSat() + Increment); TBA_VKCtrlRight: - SetSat(255); + SetSat(FMaxSat); TBA_VKUp: - SetSat(FSat + Increment); + SetSat(GetSat() + Increment); TBA_VKCtrlUp: - SetSat(255); + SetSat(FMaxSat); TBA_VKDown: - SetSat(FSat - Increment); + SetSat(GetSat() - Increment); TBA_VKCtrlDown: SetSat(0); else diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas index d684d3495..431a0c49b 100644 --- a/components/mbColorLib/SLColorPicker.pas +++ b/components/mbColorLib/SLColorPicker.pas @@ -251,9 +251,9 @@ var begin triple := HSLToRGBTriple(FHue, FSat, FLum); if not WebSafe then - Result := RGBTripleToTColor(triple) + Result := RGBTripleToColor(triple) else - Result := GetWebSafe(RGBTripleToTColor(triple)); + Result := GetWebSafe(RGBTripleToColor(triple)); end; function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor; @@ -262,9 +262,9 @@ var begin triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height)); if not WebSafe then - Result := RGBTripleToTColor(triple) + Result := RGBTripleToColor(triple) else - Result := GetWebSafe(RGBTripleToTColor(triple)); + Result := GetWebSafe(RGBTripleToColor(triple)); end; procedure TSLColorPicker.CNKeyDown( diff --git a/components/mbColorLib/Scanlines.pas b/components/mbColorLib/Scanlines.pas index 829ac1187..93941c845 100644 --- a/components/mbColorLib/Scanlines.pas +++ b/components/mbColorLib/Scanlines.pas @@ -25,7 +25,7 @@ function RGBtoRGBTriple(R, G, B: byte): TRGBTriple; function RGBtoRGBQuad(R, G, B: byte): TRGBQuad; overload; function RGBToRGBQuad(c: TColor): TRGBQuad; overload; function RGBQuadToRGB(q: TRGBQuad): TColor; -function RGBTripleToTColor(RGBTriple : TRGBTriple) : TColor; +function RGBTripleToColor(RGBTriple : TRGBTriple) : TColor; implementation @@ -66,7 +66,7 @@ begin Result := RGB(q.rgbRed, q.rgbGreen, q.rgbBlue); end; -function RGBTripleToTColor(RGBTriple: TRGBTriple): TColor; +function RGBTripleToColor(RGBTriple: TRGBTriple): TColor; begin Result := RGBTriple.rgbtBlue shl 16 + RGBTriple.rgbtGreen shl 8 + RGBTriple.rgbtRed; end; diff --git a/components/mbColorLib/VColorPicker.pas b/components/mbColorLib/VColorPicker.pas index c9713cbe2..523058c6e 100644 --- a/components/mbColorLib/VColorPicker.pas +++ b/components/mbColorLib/VColorPicker.pas @@ -18,12 +18,19 @@ uses type TVColorPicker = class(TmbTrackBarPicker) private - FHue, FSat, FVal: integer; - function ArrowPosFromVal(l: integer): integer; + FHue, FSat, FVal: Double; + FMaxHue, FMaxSat, FMaxVal: Integer; + function ArrowPosFromVal(v: integer): integer; function ValFromArrowPos(p: integer): integer; + function GetHue: Integer; + function GetSat: Integer; function GetSelectedColor: TColor; + function GetValue: Integer; procedure SetSelectedColor(c: TColor); procedure SetHue(h: integer); + procedure SetMaxHue(h: Integer); + procedure SetMaxSat(s: Integer); + procedure SetMaxVal(v: Integer); procedure SetSat(s: integer); procedure SetValue(v: integer); protected @@ -34,9 +41,12 @@ type public constructor Create(AOwner: TComponent); override; published - property Hue: integer read FHue write SetHue default 0; - property Saturation: integer read FSat write SetSat default 0; - property Value: integer read FVal write SetValue default 255; + property Hue: integer read GetHue write SetHue; + property Saturation: integer read GetSat write SetSat; + property Value: integer read GetValue write SetValue; + property MaxHue: Integer read FMaxHue write SetMaxHue default 359; + property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255; + property MaxValue: Integer read FMaxVal write SetMaxVal default 255; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; end; @@ -47,13 +57,15 @@ implementation constructor TVColorPicker.Create(AOwner: TComponent); begin inherited; - FGradientWidth := 256; + FMaxHue := 359; + FMaxSat := 255; + FMaxVal := 255; + FGradientWidth := FMaxVal + 1; FGradientHeight := 12; FHue := 0; FSat := 0; - FArrowPos := ArrowPosFromVal(255); FChange := false; - SetValue(255); + SetValue(FMaxVal); HintFormat := 'Value: %value (selected)'; FManual := false; FChange := true; @@ -61,16 +73,31 @@ end; function TVColorPicker.GetGradientColor(AValue: Integer): TColor; begin - Result := HSVtoColor(FHue, FSat, AValue); + Result := HSVtoColor(FHue, FSat, AValue / FMaxVal); +end; + +function TVColorPicker.GetHue: Integer; +begin + Result := round(FHue * FMaxHue); +end; + +function TVColorPicker.GetSat: Integer; +begin + Result := round(FSat * FMaxSat); +end; + +function TVColorPicker.GetValue: Integer; +begin + Result := round(FVal * FMaxVal); end; procedure TVColorPicker.SetHue(h: integer); begin - if h > 360 then h := 360; + if h > FMaxHue+1 then h := FMaxHue + 1; if h < 0 then h := 0; - if FHue <> h then + if GetHue() <> h then begin - FHue := h; + FHue := h / (FMaxHue + 1); FManual := false; CreateGradient; Invalidate; @@ -78,13 +105,44 @@ begin end; end; +procedure TVColorPicker.SetMaxHue(h: Integer); +begin + if h = FMaxHue then + exit; + FMaxHue := h; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure TVColorPicker.SetMaxSat(s: Integer); +begin + if s = FMaxSat then + exit; + FMaxSat := s; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + +procedure TVColorPicker.SetMaxVal(v: Integer); +begin + if v = FMaxVal then + exit; + FMaxVal := v; + FGradientWidth := FMaxVal + 1; + CreateGradient; + Invalidate; + if FChange and Assigned(OnChange) then OnChange(Self); +end; + procedure TVColorPicker.SetSat(s: integer); begin - if s > 255 then s := 255; + if s > FMaxSat then s := FMaxSat; if s < 0 then s := 0; - if FSat <> s then + if GetSat() <> s then begin - FSat := s; + FSat := s / FMaxSat; FManual := false; CreateGradient; Invalidate; @@ -92,19 +150,19 @@ begin end; end; -function TVColorPicker.ArrowPosFromVal(l: integer): integer; +function TVColorPicker.ArrowPosFromVal(v: integer): integer; var a: integer; begin if Layout = lyHorizontal then begin - a := Round(((Width - 12)/255)*l); + a := Round((Width - 12) * v / FMaxVal); if a > Width - FLimit then a := Width - FLimit; end else begin - l := 255 - l; - a := Round(((Height - 12)/255)*l); + v := FMaxVal - v; + a := Round((Height - 12) * v / FMaxVal); if a > Height - FLimit then a := Height - FLimit; end; if a < 0 then a := 0; @@ -116,21 +174,21 @@ var r: integer; begin if Layout = lyHorizontal then - r := Round(p/((Width - 12)/255)) + r := Round(p / (Width - 12) * FMaxVal) else - r := Round(255 - p/((Height - 12)/255)); + r := Round(FMaxVal - p / (Height - 12) * FMaxVal); if r < 0 then r := 0; - if r > 255 then r := 255; + if r > FMaxVal then r := FMaxVal; Result := r; end; procedure TVColorPicker.SetValue(V: integer); begin if v < 0 then v := 0; - if v > 255 then v := 255; - if FVal <> v then + if v > FMaxVal then v := FMaxVal; + if GetValue() <> v then begin - FVal := v; + FVal := v / FMaxVal; FArrowPos := ArrowPosFromVal(v); FManual := false; Invalidate; @@ -140,15 +198,14 @@ end; function TVColorPicker.GetSelectedColor: TColor; begin - if not WebSafe then - Result := HSVtoColor(FHue, FSat, FVal) - else - Result := GetWebSafe(HSVtoColor(FHue, FSat, FVal)); + Result := HSVtoColor(FHue, FSat, FVal); + if WebSafe then + Result := GetWebSafe(Result); end; function TVColorPicker.GetSelectedValue: integer; begin - Result := FVal; + Result := GetValue(); end; procedure TVColorPicker.SetSelectedColor(c: TColor); @@ -156,7 +213,7 @@ var h, s, v: integer; begin if WebSafe then c := GetWebSafe(c); - RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); + RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v); FChange := false; SetHue(h); SetSat(s); @@ -168,38 +225,41 @@ end; function TVColorPicker.GetArrowPos: integer; begin - Result := ArrowPosFromVal(FVal); + if FMaxVal = 0 then + Result := inherited GetArrowPos + else + Result := ArrowPosFromVal(GetValue()); end; procedure TVColorPicker.Execute(tbaAction: integer); begin case tbaAction of TBA_Resize: - SetValue(FVal); + SetValue(GetValue()); TBA_MouseMove: - FVal := ValFromArrowPos(FArrowPos); + SetValue(ValFromArrowPos(FArrowPos)); TBA_MouseDown: - FVal := ValFromArrowPos(FArrowPos); + SetValue(ValFromArrowPos(FArrowPos)); TBA_MouseUp: - FVal := ValFromArrowPos(FArrowPos); + SetValue(ValFromArrowPos(FArrowPos)); TBA_WheelUp: - SetValue(FVal + Increment); + SetValue(GetValue() + Increment); TBA_WheelDown: - SetValue(FVal - Increment); + SetValue(GetValue() - Increment); TBA_VKRight: - SetValue(FVal + Increment); + SetValue(GetValue() + Increment); TBA_VKCtrlRight: - SetValue(255); + SetValue(FMaxVal); TBA_VKLeft: - SetValue(FVal - Increment); + SetValue(GetValue() - Increment); TBA_VKCtrlLeft: SetValue(0); TBA_VKUp: - SetValue(FVal + Increment); + SetValue(GetValue() + Increment); TBA_VKCtrlUp: - SetValue(255); + SetValue(FMaxVal); TBA_VKDown: - SetValue(FVal - Increment); + SetValue(GetValue() - Increment); TBA_VKCtrlDown: SetValue(0); else