You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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(
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user