pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

mbColorLib: All HSV/HSL controls have a property for MaxHue/MaxSaturation/MaxValue (MaxLuminance). Some refactoring avoiding duplicate storage of H, S, L (V) in the complex pickers.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5540 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-19 16:38:29 +00:00
parent d42ba252f3
commit c75b85e42a
30 changed files with 1399 additions and 803 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
components/mbColorLib/BColorPicker.pas
View File

@ -37,8 +37,8 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Red: integer read FRed write SetRed default 122; property Red: integer read FRed write SetRed default 128;
property Green: integer read FGreen write SetGreen default 122; property Green: integer read FGreen write SetGreen default 128;
property Blue: integer read FBlue write SetBlue default 255; property Blue: integer read FBlue write SetBlue default 255;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property Layout default lyVertical; property Layout default lyVertical;
@ -57,9 +57,9 @@ constructor TBColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FRed := 122; FRed := 128;
FGreen := 122; FGreen := 128;
FBlue := 255; FBlue := 255;
FArrowPos := ArrowPosFromBlue(255); FArrowPos := ArrowPosFromBlue(255);
FChange := false; FChange := false;

24
components/mbColorLib/CColorPicker.pas
View File

@ -54,7 +54,7 @@ constructor TCColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FCyan := 255; FCyan := 255;
FMagenta := 0; FMagenta := 0;
FYellow := 0; FYellow := 0;
@ -70,7 +70,7 @@ end;
function TCColorPicker.GetGradientColor(AValue: Integer): TColor; function TCColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(AValue, FMagenta, FYellow, FBlack); Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack);
end; end;
procedure TCColorPicker.SetCyan(C: integer); procedure TCColorPicker.SetCyan(C: integer);
@ -158,10 +158,9 @@ end;
function TCColorPicker.GetSelectedColor: TColor; function TCColorPicker.GetSelectedColor: TColor;
begin begin
if not WebSafe then Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
end; end;
function TCColorPicker.GetSelectedValue: integer; function TCColorPicker.GetSelectedValue: integer;
@ -176,13 +175,16 @@ begin
if WebSafe then clr := GetWebSafe(clr); if WebSafe then clr := GetWebSafe(clr);
ColorToCMYK(clr, c, m, y, k); ColorToCMYK(clr, c, m, y, k);
FChange := false; FChange := false;
SetMagenta(m); FMagenta := m;
SetYellow(y); FYellow := y;
SetBlack(k); FBlack := k;
SetCyan(c); FCyan := c;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
FManual := false; FManual := false;
FChange := true; FChange := true;
if Assigned(OnChange) then OnChange(Self);
end; end;
function TCColorPicker.GetArrowPos: integer; function TCColorPicker.GetArrowPos: integer;

10
components/mbColorLib/GColorPicker.pas
View File

@ -32,9 +32,9 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Red: integer read FRed write SetRed default 122; property Red: integer read FRed write SetRed default 128;
property Green: integer read FGreen write SetGreen default 255; property Green: integer read FGreen write SetGreen default 255;
property Blue: integer read FBlue write SetBlue default 122; property Blue: integer read FBlue write SetBlue default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property Layout default lyVertical; property Layout default lyVertical;
end; end;
@ -50,10 +50,10 @@ constructor TGColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FRed := 122; FRed := 128;
FGreen := 255; FGreen := 255;
FBlue := 122; FBlue := 128;
FArrowPos := ArrowPosFromGreen(255); FArrowPos := ArrowPosFromGreen(255);
FChange := false; FChange := false;
Layout := lyVertical; Layout := lyVertical;

4
components/mbColorLib/HColorPicker.pas
View File

@ -65,7 +65,7 @@ begin
FMaxSat := 255; FMaxSat := 255;
FMaxVal := 255; FMaxVal := 255;
FGradientWidth := FMaxHue + 1; FGradientWidth := FMaxHue + 1;
FGradientHeight := 12; FGradientHeight := 1;
FSat := 1.0; FSat := 1.0;
FVal := 1.0; FVal := 1.0;
FChange := false; FChange := false;
@ -80,7 +80,7 @@ var
h: Double; h: Double;
begin begin
if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue; if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue;
h := AValue / (FMaxHue + 1); h := AValue / FMaxHue;
Result := HSVtoColor(h, FSat, FVal); Result := HSVtoColor(h, FSat, FVal);
end; end;

274
components/mbColorLib/HRingPicker.pas
View File

@ -18,7 +18,8 @@ uses
type type
THRingPicker = class(TmbColorPickerControl) THRingPicker = class(TmbColorPickerControl)
private private
FHue, FSat, FValue: integer; FHue, FSat, FValue: Double;
FMaxHue, FMaxSat, FMaxValue: Integer;
FHueLineColor: TColor; FHueLineColor: TColor;
FSelectedColor: TColor; FSelectedColor: TColor;
FManual: boolean; FManual: boolean;
@ -26,7 +27,14 @@ type
FChange: boolean; FChange: boolean;
FRadius: integer; FRadius: integer;
FDoChange: boolean; FDoChange: boolean;
FDragging: Boolean;
function GetHue: Integer;
function GetSat: Integer;
function GetValue: Integer;
function RadHue(New: integer): integer; function RadHue(New: integer): integer;
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetRadius(r: integer); procedure SetRadius(r: integer);
procedure SetValue(v: integer); procedure SetValue(v: integer);
procedure SetHue(h: integer); procedure SetHue(h: integer);
@ -54,9 +62,12 @@ type
function GetColorAtPoint(x, y: integer): TColor; override; function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor; property ColorUnderCursor;
published published
property Hue: integer read FHue write SetHue default 0; property Hue: integer read GetHue write SetHue;
property Saturation: integer read FSat write SetSat default 0; property Saturation: integer read GetSat write SetSat;
property Value: integer read FValue write SetValue default 255; 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 FMaxValue write SetMaxValue default 255;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property SelectedColor default clNone; property SelectedColor default clNone;
property Radius: integer read FRadius write SetRadius default 40; property Radius: integer read FRadius write SetRadius default 40;
@ -80,9 +91,12 @@ begin
{$ELSE} {$ELSE}
SetInitialBounds(0, 0, 204, 204); SetInitialBounds(0, 0, 204, 204);
{$ENDIF} {$ENDIF}
FValue := 255; FMaxHue := 359;
FHue := 0; FMaxSat := 255;
FSat := 0; FMaxValue := 255;
FValue := 1.0;
FHue := 0.0;
FSat := 1.0;
FHueLineColor := clGray; FHueLineColor := clGray;
FSelectedColor := clNone; FSelectedColor := clNone;
FManual := false; FManual := false;
@ -102,28 +116,24 @@ end;
{ Outer loop: Y, Inner loop: X } { Outer loop: Y, Inner loop: X }
function THRingPicker.GetGradientColor2D(X, Y: Integer): TColor; function THRingPicker.GetGradientColor2D(X, Y: Integer): TColor;
var var
xcoord, ycoord: Integer; dx, dy: Integer;
dSq, radiusSq: Integer; dSq, rSq: Integer;
radius, size: Integer; radius, size: Integer;
S, H, V: Integer; H: Double;
q: TRGBQuad; q: TRGBQuad;
begin begin
size := FGradientWidth; // or Height, they are the same... size := FGradientWidth; // or Height, they are the same...
radius := size div 2; radius := size div 2;
radiusSq := sqr(radius); rSq := sqr(radius);
xcoord := X - radius; dx := X - radius;
ycoord := Y - radius; dy := Y - radius;
dSq := sqr(xcoord) + sqr(ycoord); dSq := sqr(dx) + sqr(dy);
if dSq <= radiusSq then if dSq <= rSq then
begin begin
if radius <> 0 then H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
S := round((255 * sqrt(dSq)) / radius)
else
S := 0;
H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct!
H := H + 90; H := H + 90;
if H > 360 then H := H - 360; if H > 360 then H := H - 360;
Result := HSVtoColor(H, S, FValue); Result := HSVtoColor(H/360, FSat, FValue);
if WebSafe then if WebSafe then
Result := GetWebSafe(Result); Result := GetWebSafe(Result);
end else end else
@ -146,24 +156,39 @@ end;
} }
procedure THRingPicker.UpdateCoords; procedure THRingPicker.UpdateCoords;
var var
r, angle: real; r, angle: double;
radius: integer; radius: integer;
sinAngle, cosAngle: Double; sinAngle, cosAngle: Double;
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
r := -MulDiv(radius, FSat, 255); r := -radius * FSat;
angle := -FHue * pi/180 - pi; angle := -(FHue * 2 + 1) * pi;
SinCos(angle, sinAngle, cosAngle); SinCos(angle, sinAngle, cosAngle);
mdx := round(cosAngle * r) + radius; mdx := round(cosAngle * r) + radius;
mdy := round(sinAngle * r) + radius; mdy := round(sinAngle * r) + radius;
end; end;
function THRingPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function THRingPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function THRingPicker.GetValue: Integer;
begin
Result := round(FValue * FMaxValue);
end;
procedure THRingPicker.SetHue(h: integer); procedure THRingPicker.SetHue(h: integer);
begin begin
Clamp(h, 0, 360); Clamp(h, 0, FMaxHue);
if FHue <> h then if GetHue() <> h then
begin begin
FHue := h; FHue := h / FMaxHue;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -171,12 +196,42 @@ begin
end; end;
end; end;
procedure THRingPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxValue(v: Integer);
begin
if v = FMaxValue then
exit;
FMaxValue := v;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetSat(s: integer); procedure THRingPicker.SetSat(s: integer);
begin begin
Clamp(s, 0, 255); Clamp(s, 0, FMaxSat);
if FSat <> s then if GetSat() <> s then
begin begin
FSat := s; FSat := s / FMaxSat;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -186,10 +241,10 @@ end;
procedure THRingPicker.SetValue(v: integer); procedure THRingPicker.SetValue(v: integer);
begin begin
Clamp(v, 0, 255); Clamp(v, 0, FMaxValue);
if FValue <> V then if GetValue() <> V then
begin begin
FValue := V; FValue := V / FMaxValue;
FManual := false; FManual := false;
CreateGradient; CreateGradient;
Invalidate; Invalidate;
@ -222,9 +277,9 @@ var
radius: integer; radius: integer;
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
if (FHue >= 0) and (FHue <= 360) then if (FHue >= 0) and (FHue <= 1.0) then
begin begin
angle := -FHue*PI/180; angle := -FHue * 2 * pi;
SinCos(angle, sinAngle, cosAngle); SinCos(angle, sinAngle, cosAngle);
Canvas.Pen.Color := FHueLineColor; Canvas.Pen.Color := FHueLineColor;
Canvas.MoveTo(radius, radius); Canvas.MoveTo(radius, radius);
@ -267,33 +322,21 @@ end;
procedure THRingPicker.SelectionChanged(x, y: integer); procedure THRingPicker.SelectionChanged(x, y: integer);
var var
angle, Distance, xDelta, yDelta, Radius: integer; angle, dx, dy, Radius: integer;
begin begin
if not PointInCircle(Point(x, y), Min(Width, Height)) then FSelectedColor := clWhite;
begin radius := Min(Width, Height) div 2;
FChange := false; dx := x - radius;
SetSelectedColor(clNone); dy := y - radius;
FChange := true; angle := round(360 + 180*arctan2(-dy, dx) / pi);
Exit;
end
else
FSelectedColor := clWhite;
Radius := Min(Width, Height) div 2;
xDelta := x - Radius;
yDelta := y - Radius;
angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
if angle < 0 then if angle < 0 then
Inc(angle, 360) inc(angle, 360)
else if angle > 360 then else if angle > 360 then
Dec(angle, 360); dec(angle, 360);
FChange := false; FChange := false;
SetHue(angle); SetHue(MulDiv(angle, FMaxHue + 1, 360));
distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
if distance >= radius then
SetSat(255)
else
SetSat(MulDiv(distance, 255, radius));
FChange := true; FChange := true;
Invalidate;
end; end;
procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
@ -304,37 +347,42 @@ begin
ClipCursor(nil); ClipCursor(nil);
{$ENDIF} {$ENDIF}
if csDesigning in ComponentState then Exit; if csDesigning in ComponentState then Exit;
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then if (Button = mbLeft) and FDragging then
begin begin
mdx := x; mdx := x;
mdy := y; mdy := y;
FDoChange := true; FDoChange := true;
SelectionChanged(X, Y); SelectionChanged(X, Y);
FManual := true; FManual := true;
FDragging := false;
end; end;
end; end;
procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
{$IFDEF DELPHI}
var var
R: TRect; R: TRect;
{$ENDIF}
begin begin
inherited; inherited;
if csDesigning in ComponentState then Exit; if csDesigning in ComponentState then
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then Exit;
begin if (Button = mbLeft) and MouseOnPicker(X, Y)
then begin
mdx := x; mdx := x;
mdy := y; mdy := y;
{$IFDEF DELPHI}
R := ClientRect; R := ClientRect;
InflateRect(R, 1, 1); InflateRect(R, 1, 1);
R.TopLeft := ClientToScreen(R.TopLeft); R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight); R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R); ClipCursor(@R);
{$ENDIF} {$ENDIF}
FDoChange := true; FDoChange := true;
SelectionChanged(X, Y); SelectionChanged(X, Y);
FManual := true; FManual := true;
FDragging := true;
end; end;
SetFocus; SetFocus;
end; end;
@ -355,7 +403,7 @@ procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin begin
inherited; inherited;
if csDesigning in ComponentState then Exit; if csDesigning in ComponentState then Exit;
if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then if (ssLeft in Shift) and FDragging then
begin begin
mdx := x; mdx := x;
mdy := y; mdy := y;
@ -369,10 +417,9 @@ function THRingPicker.GetSelectedColor: TColor;
begin begin
if FSelectedColor <> clNone then if FSelectedColor <> clNone then
begin begin
if not WebSafe then Result := HSVtoColor(FHue, FSat, FValue);
Result := HSVtoColor(FHue, FSat, FValue) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
end end
else else
Result := clNone; Result := clNone;
@ -380,29 +427,25 @@ end;
function THRingPicker.GetColorAtPoint(x, y: integer): TColor; function THRingPicker.GetColorAtPoint(x, y: integer): TColor;
var var
angle, distance, xDelta, yDelta, radius: integer; angle: Double;
h, s: integer; dx, dy, radius: integer;
h: Double;
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
xDelta := x - Radius;
yDelta := y - Radius;
angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
if angle < 0 then
Inc(angle, 360)
else if angle > 360 then
Dec(angle, 360);
h := angle;
distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
if distance >= radius then
s := 255
else
s := MulDiv(distance, 255, radius);
if PointInCircle(Point(x, y), Min(Width, Height)) then if PointInCircle(Point(x, y), Min(Width, Height)) then
begin begin
if not WebSafe then dx := x - Radius;
Result := HSVtoColor(h, s, FValue) dy := y - Radius;
else angle := 360 + 180 * arctan2(-dy, dx) / pi;
Result := GetWebSafe(HSVtoColor(h, s, FValue)); if angle < 0 then
angle := angle + 360
else if angle > 360 then
angle := angle - 360;
h := angle / 360;
Result := HSVtoColor(h, FSat, FValue);
if WebSafe then
Result := GetWebSafe(Result);
end end
else else
Result := clNone; Result := clNone;
@ -411,15 +454,16 @@ end;
procedure THRingPicker.SetSelectedColor(c: TColor); procedure THRingPicker.SetSelectedColor(c: TColor);
var var
changeSave: boolean; changeSave: boolean;
h, s, v: Double;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then c := GetWebSafe(c);
changeSave := FChange; changeSave := FChange;
FManual := false; FManual := false;
Fchange := false; FChange := false;
SetValue(GetVValue(c)); RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue);
SetHue(GetHValue(c));
SetSat(GetSValue(c));
FSelectedColor := c; FSelectedColor := c;
UpdateCoords;
Invalidate;
FChange := changeSave; FChange := changeSave;
if FChange and Assigned(FOnChange) then FOnChange(Self); if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true; FChange := true;
@ -427,49 +471,29 @@ end;
function THRingPicker.RadHue(New: integer): integer; function THRingPicker.RadHue(New: integer): integer;
begin begin
if New < 0 then New := New + 360; if New < 0 then New := New + (FMaxHue + 1);
if New > 360 then New := New - 360; if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New; Result := New;
end; end;
procedure THRingPicker.CNKeyDown( procedure THRingPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var var
Shift: TShiftState; shift: TShiftState;
FInherited: boolean; FInherited: boolean;
delta: Integer;
begin begin
FInherited := false; FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData); shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then if ssCtrl in Shift then
case Message.CharCode of delta := 10
VK_LEFT:
begin
FChange := false;
SetHue(RadHue(FHue + 1));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
begin
FChange := false;
SetHue(RadHue(FHue - 1));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end
else else
begin delta := 1;
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of case Message.CharCode of
VK_LEFT: VK_LEFT:
begin begin
FChange := false; FChange := false;
SetHue(RadHue(FHue + 10)); SetHue(RadHue(GetHue() + delta));
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -477,7 +501,7 @@ begin
VK_RIGHT: VK_RIGHT:
begin begin
FChange := false; FChange := false;
SetHue(RadHue(FHue - 10)); SetHue(RadHue(GetHue() - delta));
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -488,9 +512,9 @@ begin
inherited; inherited;
end; end;
end; end;
if not FInherited then if not FInherited then
if Assigned(OnKeyDown) then if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift); OnKeyDown(Self, Message.CharCode, Shift);
end; end;
end. end.

307
components/mbColorLib/HSColorPicker.pas
View File

@ -4,6 +4,8 @@ unit HSColorPicker;
{$MODE DELPHI} {$MODE DELPHI}
{$ENDIF} {$ENDIF}
{$DEFINE USE COLOR_TO_RGB}
interface interface
uses uses
@ -21,11 +23,18 @@ type
THSColorPicker = class(TmbColorPickerControl) THSColorPicker = class(TmbColorPickerControl)
private private
FHue, FSaturation, FLuminance: integer; FHue, FSat, FLum: Double;
FLum: integer; FMaxHue, FMaxSat, FMaxLum: Integer;
dx, dy, mxx, myy: integer; dx, dy, mxx, myy: integer;
procedure SetHValue(h: integer); function GetHue: Integer;
procedure SetSValue(s: integer); function GetLum: Integer;
function GetSat: Integer;
procedure SetHue(H: integer);
procedure SetLum(L: Integer);
procedure SetSat(S: integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
protected protected
procedure CorrectCoords(var x, y: integer); procedure CorrectCoords(var x, y: integer);
function GetGradientColor2D(X, Y: Integer): TColor; override; function GetGradientColor2D(X, Y: Integer): TColor; override;
@ -42,11 +51,15 @@ type
function PredictColor: TColor; function PredictColor: TColor;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
property Lum: integer read FLum write FLum default 120; property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
// property Lum: integer read GetLum write SetLum;
published published
property SelectedColor default clRed; property SelectedColor default clRed;
property HueValue: integer read FHue write SetHValue default 0; property Luminance: Integer read GetLum write SetLum;
property SaturationValue: integer read FSaturation write SetSValue default 240; property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240;
property MarkerStyle default msCross; property MarkerStyle default msCross;
property OnChange; property OnChange;
end; end;
@ -61,20 +74,22 @@ uses
constructor THSColorPicker.Create(AOwner: TComponent); constructor THSColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 240; FMaxHue := 359;
FGradientHeight := 241; FMaxSat := 240;
FMaxLum := 240;
FGradientWidth := FMaxHue + 1;
FGradientHeight := FMaxSat + 1;
{$IFDEF DELPHI} {$IFDEF DELPHI}
Width := 239; Width := 239;
Height := 240; Height := 240;
{$ELSE} {$ELSE}
SetInitialBounds(0, 0, 239, 240); SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
{$ENDIF} {$ENDIF}
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex'; HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
FHue := 0; FHue := 0;
FSaturation := 240; FSat := 1.0;
FLuminance := 120; FLum := 0.5;
FSelected := clRed; FSelected := clRed;
FLum := 120;
FManual := false; FManual := false;
dx := 0; dx := 0;
dy := 0; dy := 0;
@ -91,7 +106,11 @@ end;
function THSColorPicker.GetGradientColor2D(X, Y: Integer): TColor; function THSColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
begin begin
Result := HSLRangeToRGB(x, FBufferBmp.Height - 1 - y, 120); {$IFDEF USE_COLOR_TO_RGB}
Result := HSLToColor(x / FMaxHue, (FBufferBmp.Height - 1 - y) / FMaxSat, FLum);
{$ELSE}
Result := HSLtoRGB(x / FMaxHue, (FMaxSat - y) / FMaxSat, FLum);
{$ENDIF}
end; end;
procedure THSColorPicker.CorrectCoords(var x, y: integer); procedure THSColorPicker.CorrectCoords(var x, y: integer);
@ -103,11 +122,16 @@ end;
procedure THSColorPicker.DrawMarker(x, y: integer); procedure THSColorPicker.DrawMarker(x, y: integer);
var var
c: TColor; c: TColor;
L: Double;
begin begin
CorrectCoords(x, y); CorrectCoords(x, y);
RGBtoHSLRange(FSelected, FHue, FSaturation, FLuminance);
if Assigned(FOnChange) then {$IFDEF USE_COLOR_TO_RGB}
FOnChange(Self); ColorToHSL(FSelected, FHue, FSat, L);
{$ELSE}
RGBToHSL(FSelected, FHue, FSat, L);
{$ENDIF}
dx := x; dx := x;
dy := y; dy := y;
if Focused or (csDesigning in ComponentState) then if Focused or (csDesigning in ComponentState) then
@ -117,15 +141,37 @@ begin
InternalDrawMarker(x, y, c); InternalDrawMarker(x, y, c);
end; end;
function THSColorPicker.GetHue: Integer;
begin
Result := Round(FHue * FMaxHue);
end;
function THSColorPicker.GetLum: Integer;
begin
Result := Round(FLum * FMaxLum);
end;
function THSColorPicker.GetSat: Integer;
begin
Result := Round(FSat * FMaxSat);
end;
procedure THSColorPicker.SetSelectedColor(c: TColor); procedure THSColorPicker.SetSelectedColor(c: TColor);
var
L: Double;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then c := GetWebSafe(c);
RGBtoHSLRange(c, FHue, FSaturation, FLuminance); {$IFDEF USE_COLOR_TO_RGB}
ColorToHSL(c, FHue, FSat, L);
{$ELSE}
RGBtoHSL(c, FHue, FSat, L);
{$ENDIF}
FSelected := c; FSelected := c;
FManual := false; FManual := false;
mxx := Round(FHue*(Width/239)); mxx := Round(FHue * Width);
myy := Round((240-FSaturation)*(Height/240)); myy := Round((1.0 - FSat) * Height);
Invalidate; Invalidate;
if Assigned(OnChange) then OnChange(Self);
end; end;
procedure THSColorPicker.Paint; procedure THSColorPicker.Paint;
@ -142,21 +188,23 @@ begin
end; end;
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{$IFDEF DELPHI}
var var
R: TRect; R: TRect;
{$ENDIF}
begin begin
inherited; inherited;
mxx := x; mxx := x;
myy := y; myy := y;
if Button = mbLeft then if Button = mbLeft then
begin begin
{$IFDEF DELPHI}
R := ClientRect; R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft); R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight); R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R); ClipCursor(@R);
{$ENDIF} {$ENDIF}
FSelected := GetColorAtPoint(x, y); SetSelectedColor(GetColorAtPoint(x, y));
FManual := true; FManual := true;
Invalidate; Invalidate;
end; end;
@ -171,7 +219,7 @@ begin
{$ENDIF} {$ENDIF}
mxx := x; mxx := x;
myy := y; myy := y;
FSelected := GetColorAtPoint(x, y); SetSelectedColor(GetColorAtPoint(x, y));
FManual := true; FManual := true;
Invalidate; Invalidate;
end; end;
@ -183,7 +231,7 @@ begin
begin begin
mxx := x; mxx := x;
myy := y; myy := y;
FSelected := GetColorAtPoint(x, y); SetSelectedColor(GetColorAtPoint(x, y));
FManual := true; FManual := true;
Invalidate; Invalidate;
end; end;
@ -191,121 +239,138 @@ end;
function THSColorPicker.PredictColor: TColor; function THSColorPicker.PredictColor: TColor;
var var
FTHue, FTSat, FTLum: integer; H, S, L: Double;
begin begin
RGBtoHSLRange(GetColorUnderCursor, FTHue, FTSat, FTLum); {$IFDEF USE_COLOR_TO_RGB}
Result := HSLRangeToRGB(FTHue, FTSat, FLum); ColorToHSL(GetColorUnderCursor, H, S, L);
{$ELSE}
RGBtoHSL(GetColorUnderCursor, H, S, L);
{$ENDIF}
Result := HSLToRGB(H, S, L);
end; end;
procedure THSColorPicker.CNKeyDown( procedure THSColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var var
Shift: TShiftState; Shift: TShiftState;
FInherited: boolean; FInherited: boolean;
delta: Integer;
begin begin
FInherited := false; FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData); Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then if (ssCtrl in Shift) then
case Message.CharCode of delta := 10
VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else else
begin delta := 1;
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of case Message.CharCode of
VK_LEFT: VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin begin
mxx := dx - 10; FInherited := true;
myy := dy; inherited;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end; end;
VK_RIGHT:
begin
mxx := dx + 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
end; end;
if not FInherited then
if Assigned(OnKeyDown) then if not FInherited then
OnKeyDown(Self, Message.CharCode, Shift); if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end; end;
procedure THSColorPicker.SetHValue(h: integer); procedure THSColorPicker.SetHue(H: integer);
begin begin
Clamp(h, 0, 239); Clamp(H, 0, FMaxHue);
FHue := h; FHue := H / FMaxHue;
SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); // why hard-coded 120? {$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
{$ENDIF}
end; end;
procedure THSColorPicker.SetSValue(s: integer); // Sets the luminance value used for the display. It is not necessarily that
// of the selected color.
procedure THSColorPicker.SetLum(L: Integer);
begin begin
Clamp(s, 0, 240); Clamp(L, 0, FMaxLum);
FSaturation := s; FLum := L / FMaxLum;
SetSelectedColor(HSLRangeToRGB(FHue, FSaturation, 120)); CreateGradient;
{$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
{$ENDIF}
end;
procedure THSColorPicker.SetSat(S: integer);
begin
Clamp(S, 0, FMaxSat);
FSat := S;
{$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
{$ENDIF}
end;
procedure THSColorPicker.SetMaxHue(H: Integer);
begin
if H = FMaxHue then
exit;
FMaxHue := H;
FGradientWidth := FMaxHue + 1;
CreateGradient;
Invalidate;
end;
procedure THSColorPicker.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
FMaxSat := S;
FGradientHeight := FMaxSat + 1;
CreateGradient;
Invalidate;
end;
procedure THSColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
CreateGradient;
Invalidate;
if Assigned(OnChange) then OnChange(Self);
end; end;
end. end.

139
components/mbColorLib/HSLColorPicker.pas
View File

@ -25,7 +25,6 @@ type
FHSPicker: THSColorPicker; FHSPicker: THSColorPicker;
FLPicker: TLColorPicker; FLPicker: TLColorPicker;
FSelectedColor: TColor; FSelectedColor: TColor;
FHValue, FSValue, FLValue: integer;
FRValue, FGValue, FBValue: integer; FRValue, FGValue, FBValue: integer;
FHSHint, FLHint: string; FHSHint, FLHint: string;
FLMenu, FHSMenu: TPopupMenu; FLMenu, FHSMenu: TPopupMenu;
@ -33,14 +32,23 @@ type
FHSCursor, FLCursor: TCursor; FHSCursor, FLCursor: TCursor;
PBack: TBitmap; PBack: TBitmap;
function GetManual: boolean; function GetManual: boolean;
function GetH: Integer;
function GetS: Integer;
function GetL: Integer;
function GetMaxH: Integer;
function GetMaxS: Integer;
function GetMaxL: Integer;
procedure SetLumIncrement(i: integer); procedure SetLumIncrement(i: integer);
procedure SelectColor(c: TColor); procedure SelectColor(c: TColor);
procedure SetH(v: integer); procedure SetH(H: integer);
procedure SetS(v: integer); procedure SetS(S: integer);
procedure SetL(v: integer); procedure SetL(L: integer);
procedure SetR(v: integer); procedure SetMaxH(H: Integer);
procedure SetG(v: integer); procedure SetMaxS(S: Integer);
procedure SetB(v: integer); procedure SetMaxL(L: Integer);
procedure SetR(R: integer);
procedure SetG(G: integer);
procedure SetB(B: integer);
procedure SetHSHint(h: string); procedure SetHSHint(h: string);
procedure SetLHint(h: string); procedure SetLHint(h: string);
procedure SetLMenu(m: TPopupMenu); procedure SetLMenu(m: TPopupMenu);
@ -66,12 +74,12 @@ type
function GetHexColorUnderCursor: string; override; function GetHexColorUnderCursor: string; override;
function GetSelectedHexColor: string; function GetSelectedHexColor: string;
property ColorUnderCursor; property ColorUnderCursor;
property HValue: integer read FHValue write SetH default 0; property Hue: integer read GetH write SetH;
property SValue: integer read FSValue write SetS default 240; property Saturation: integer read GetS write SetS;
property LValue: integer read FLValue write SetL default 120; property Luminance: integer read GetL write SetL;
property RValue: integer read FRValue write SetR default 255; property Red: integer read FRValue write SetR default 255;
property GValue: integer read FGValue write SetG default 0; property Green: integer read FGValue write SetG default 0;
property BValue: integer read FBValue write SetB default 0; property Blue: integer read FBValue write SetB default 0;
property Manual: boolean read GetManual; property Manual: boolean read GetManual;
published published
property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1; property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1;
@ -82,6 +90,9 @@ type
property LPickerHintFormat: string read FLHint write SetLHint; property LPickerHintFormat: string read FLHint write SetLHint;
property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault; property HSPickerCursor: TCursor read FHSCursor write SetHSCursor default crDefault;
property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault; property LPickerCursor: TCursor read FLCursor write SetLCursor default crDefault;
property MaxHue: Integer read GetMaxH write SetMaxH default 359;
property MaxSaturation: Integer read GetMaxS write SetMaxS default 240;
property MaxLuminance: Integer read GetMaxL write SetMaxL default 240;
property TabStop default true; property TabStop default true;
property ShowHint; property ShowHint;
property ParentShowHint; property ParentShowHint;
@ -138,6 +149,9 @@ begin
{$ENDIF} {$ENDIF}
Anchors := [akLeft, akTop, akRight, akBottom]; Anchors := [akLeft, akTop, akRight, akBottom];
Visible := true; Visible := true;
MaxHue := 359;
MaxSaturation := 240;
MaxLuminance := 240;
OnChange := HSPickerChange; OnChange := HSPickerChange;
OnMouseMove := DoMouseMove; OnMouseMove := DoMouseMove;
end; end;
@ -156,12 +170,16 @@ begin
{$ENDIF} {$ENDIF}
Anchors := [akRight, akTop, akBottom]; Anchors := [akRight, akTop, akBottom];
Visible := true; Visible := true;
MaxHue := 359;
MaxSaturation := 240;
MaxLuminance := 240;
Luminance := 120;
OnChange := LPickerChange; OnChange := LPickerChange;
OnMouseMove := DoMouseMove; OnMouseMove := DoMouseMove;
end; end;
FHValue := 0; Hue := 0;
FSValue := 240; Saturation := 240;
FLValue := 120; Luminance := 120;
FRValue := 255; FRValue := 255;
FGValue := 0; FGValue := 0;
FBValue := 0; FBValue := 0;
@ -179,23 +197,21 @@ end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject); procedure THSLColorPicker.HSPickerChange(Sender: TObject);
begin begin
FLPicker.Hue := FHSPicker.HueValue; FLPicker.Hue := FHSPicker.Hue;
FLPicker.Saturation := FHSPicker.SaturationValue; FLPicker.Saturation := FHSPicker.Saturation;
FLPicker.Invalidate;
DoChange; DoChange;
end; end;
procedure THSLColorPicker.LPickerChange(Sender: TObject); procedure THSLColorPicker.LPickerChange(Sender: TObject);
begin begin
FHSPicker.Lum := FLPicker.Luminance; // FHSPicker.Lum := FLPicker.Luminance;
FSelectedColor := FLPicker.SelectedColor; FSelectedColor := FLPicker.SelectedColor;
DoChange; DoChange;
end; end;
procedure THSLColorPicker.DoChange; procedure THSLColorPicker.DoChange;
begin begin
FHValue := FLPicker.Hue;
FSValue := FLPicker.Saturation;
FLValue := FLPicker.Luminance;
FRValue := GetRValue(FLPicker.SelectedColor); FRValue := GetRValue(FLPicker.SelectedColor);
FGValue := GetGValue(FLPicker.SelectedColor); FGValue := GetGValue(FLPicker.SelectedColor);
FBValue := GetBValue(FLPicker.SelectedColor); FBValue := GetBValue(FLPicker.SelectedColor);
@ -203,6 +219,36 @@ begin
FOnChange(Self); FOnChange(Self);
end; end;
function THSLColorPicker.GetH: Integer;
begin
Result := FHSPicker.Hue;
end;
function THSLColorPicker.GetS: Integer;
begin
Result := FHSPicker.Saturation;
end;
function THSLColorPicker.GetL: integer;
begin
Result := FLPicker.Luminance;
end;
function THSLColorPicker.GetMaxH: Integer;
begin
Result := FHSPicker.MaxHue;
end;
function THSLColorPicker.GetMaxS: Integer;
begin
Result := FHSPicker.MaxSaturation;
end;
function THSLColorPicker.GetMaxL: Integer;
begin
Result := FLPicker.MaxLuminance;
end;
procedure THSLColorPicker.SelectColor(c: TColor); procedure THSLColorPicker.SelectColor(c: TColor);
begin begin
FSelectedColor := c; FSelectedColor := c;
@ -210,41 +256,56 @@ begin
FLPicker.SelectedColor := c; FLPicker.SelectedColor := c;
end; end;
procedure THSLColorPicker.SetH(v: integer); procedure THSLColorPicker.SetH(H: integer);
begin begin
FHValue := v; FHSPicker.Hue := H;
FHSPicker.HueValue := v; FLPicker.Hue := H;
FLPicker.Hue := v;
end; end;
procedure THSLColorPicker.SetS(v: integer); procedure THSLColorPicker.SetS(S: integer);
begin begin
FSValue := v; FHSPicker.Saturation := S;
FHSPicker.SaturationValue := v; FLPicker.Saturation := S;
FLPicker.Saturation := v;
end; end;
procedure THSLColorPicker.SetL(v: integer); procedure THSLColorPicker.SetL(L: integer);
begin begin
FLValue := v; FLPicker.Luminance := L;
FLPicker.Luminance := v;
end; end;
procedure THSLColorPicker.SetR(v: integer); procedure THSLColorPicker.SetMaxH(H: Integer);
begin begin
FRValue := v; FHSPicker.MaxHue := H;
FLPicker.MaxHue := H;
end;
procedure THSLColorPicker.SetMaxS(S: Integer);
begin
FHSPicker.MaxSaturation := S;
FLPicker.MaxSaturation := S;
end;
procedure THSLColorPicker.SetMaxL(L: Integer);
begin
FHSPicker.MaxLuminance := L;
FLPicker.MaxLuminance := L;
end;
procedure THSLColorPicker.SetR(R: integer);
begin
FRValue := R;
SetSelectedColor(RGB(FRValue, FGValue, FBValue)); SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end; end;
procedure THSLColorPicker.SetG(v: integer); procedure THSLColorPicker.SetG(G: integer);
begin begin
FGValue := v; FGValue := G;
SetSelectedColor(RGB(FRValue, FGValue, FBValue)); SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end; end;
procedure THSLColorPicker.SetB(v: integer); procedure THSLColorPicker.SetB(B: integer);
begin begin
FBValue := v; FBValue := B;
SetSelectedColor(RGB(FRValue, FGValue, FBValue)); SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end; end;

116
components/mbColorLib/HSLRingPicker.pas
View File

@ -25,17 +25,25 @@ type
FRingPicker: THRingPicker; FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker; FSLPicker: TSLColorPicker;
FSelectedColor: TColor; FSelectedColor: TColor;
FHValue, FSValue, FLValue: integer;
FRValue, FGValue, FBValue: integer; FRValue, FGValue, FBValue: integer;
FRingHint, FSLHint: string; FRingHint, FSLHint: string;
FSLMenu, FRingMenu: TPopupMenu; FSLMenu, FRingMenu: TPopupMenu;
FSLCursor, FRingCursor: TCursor; FSLCursor, FRingCursor: TCursor;
PBack: TBitmap; PBack: TBitmap;
function GetManual: boolean; function GetManual: boolean;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
function GetMaxHue: Integer;
function GetMaxLum: Integer;
function GetMaxSat: Integer;
procedure SelectColor(c: TColor); procedure SelectColor(c: TColor);
procedure SetH(v: integer); procedure SetHue(H: integer);
procedure SetS(v: integer); procedure SetSat(S: integer);
procedure SetL(v: integer); procedure SetLum(L: integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetR(v: integer); procedure SetR(v: integer);
procedure SetG(v: integer); procedure SetG(v: integer);
procedure SetB(v: integer); procedure SetB(v: integer);
@ -65,9 +73,9 @@ type
function GetHexColorUnderCursor: string; override; function GetHexColorUnderCursor: string; override;
function GetSelectedHexColor: string; function GetSelectedHexColor: string;
property ColorUnderCursor; property ColorUnderCursor;
property HValue: integer read FHValue write SetH default 0; property Hue: integer read GetHue write SetHue;
property SValue: integer read FSValue write SetS default 240; property Saturation: integer read GetSat write SetSat;
property LValue: integer read FLValue write SetL default 120; property Luminance: integer read GetLum write SetLum;
property RValue: integer read FRValue write SetR default 255; property RValue: integer read FRValue write SetR default 255;
property GValue: integer read FGValue write SetG default 0; property GValue: integer read FGValue write SetG default 0;
property BValue: integer read FBValue write SetB default 0; property BValue: integer read FBValue write SetB default 0;
@ -80,6 +88,9 @@ type
property SLPickerHintFormat: string read FSLHint write SetSLHint; property SLPickerHintFormat: string read FSLHint write SetSLHint;
property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault; property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault; property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
property MaxHue: Integer read GetMaxHue write SetMaxHue default 359;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
property TabStop default true; property TabStop default true;
property ShowHint; property ShowHint;
property ParentShowHint; property ParentShowHint;
@ -105,7 +116,10 @@ constructor THSLRingPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}]; // ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
DoubleBuffered := true; //DoubleBuffered := true;
FRValue := 255;
FGValue := 0;
FBValue := 0;
PBack := TBitmap.Create; PBack := TBitmap.Create;
PBack.PixelFormat := pf32bit; PBack.PixelFormat := pf32bit;
{$IFDEF DELPHI_7_UP} {$IFDEF DELPHI} {$IFDEF DELPHI_7_UP} {$IFDEF DELPHI}
@ -133,11 +147,11 @@ begin
{$ELSE} {$ELSE}
SetInitialBounds(0, 0, 246, 246); SetInitialBounds(0, 0, 246, 246);
{$ENDIF} {$ENDIF}
Radius := 100; //Radius := 40;
Align := alClient; Align := alClient;
Visible := true; Visible := true;
Saturation := 255; Saturation := FRingPicker.MaxSaturation;
Value := 255; Value := FRingPicker.MaxValue;
Hue := 0; Hue := 0;
OnChange := RingPickerChange; OnChange := RingPickerChange;
OnMouseMove := DoMouseMove; OnMouseMove := DoMouseMove;
@ -154,16 +168,14 @@ begin
{$ELSE} {$ELSE}
SetInitialBounds(63, 63, 120, 120); SetInitialBounds(63, 63, 120, 120);
{$ENDIF} {$ENDIF}
MaxSaturation := 240;
MaxLuminance := 240;
Saturation := 240;
Luminance := 240;
Visible := true; Visible := true;
OnChange := SLPickerChange; OnChange := SLPickerChange;
OnMouseMove := DoMouseMove; OnMouseMove := DoMouseMove;
end; end;
FHValue := 0;
FSValue := 255;
FLValue := 255;
FRValue := 255;
FGValue := 0;
FBValue := 0;
FRingHint := 'Hue: %h'; FRingHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex'; FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
end; end;
@ -220,9 +232,6 @@ begin
if (FRingPicker = nil) or (FSLPicker = nil) then if (FRingPicker = nil) or (FSLPicker = nil) then
exit; exit;
FHValue := FRingPicker.Hue;
FSValue := FSLPicker.Saturation;
FLValue := FSLPicker.Luminance;
FRValue := GetRValue(FSLPicker.SelectedColor); FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor); FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor); FBValue := GetBValue(FSLPicker.SelectedColor);
@ -236,36 +245,34 @@ begin
exit; exit;
FRingPicker.Hue := GetHValue(c); FRingPicker.Hue := GetHValue(c);
FRingPicker.Saturation := 255; //FRingPicker.Saturation := FRingPicker.MaxSaturation;
FRingPicker.Value := 255; //FRingPicker.Value := FRingPicker.MaxValue;
FSLPicker.SelectedColor := c; FSLPicker.SelectedColor := c;
FSelectedColor := c; FSelectedColor := c;
end; end;
procedure THSLRingPicker.SetH(v: integer); procedure THSLRingPicker.SetHue(H: integer);
begin begin
if (FRingPicker = nil) or (FSLPicker = nil) then if (FRingPicker = nil) or (FSLPicker = nil) then
exit; exit;
FHValue := v; FRingPicker.Hue := H;
FRingPicker.Hue := v; FSLPicker.Hue := H;
FSLPicker.Hue := v;
end; end;
procedure THSLRingPicker.SetS(v: integer); procedure THSLRingPicker.SetSat(S: integer);
begin begin
if (FSLPicker = nil) then if (FSLPicker = nil) then
exit; exit;
FSValue := v; FSLPicker.Saturation := S;
FSLPicker.Saturation := v;
end; end;
procedure THSLRingPicker.SetL(v: integer); procedure THSLRingPicker.SetLum(L: integer);
begin begin
if (FSLPicker = nil) then if (FSLPicker = nil) then
exit; exit;
FLValue := v; FSLPicker.Luminance := L;
FSLPicker.Luminance := v;
end; end;
procedure THSLRingPicker.SetR(v: integer); procedure THSLRingPicker.SetR(v: integer);
@ -368,4 +375,49 @@ begin
PaintParentBack(PBack); PaintParentBack(PBack);
end; end;
function THSLRingPicker.GetHue: Integer;
begin
Result := FRingPicker.Hue;
end;
function THSLRingPicker.GetSat: Integer;
begin
Result := FSLPicker.Saturation;
end;
function THSLRingPicker.GetLum: Integer;
begin
Result := FSLPicker.Luminance;
end;
function THSLRingPicker.GetMaxHue: Integer;
begin
Result := FRingPicker.MaxHue;
end;
function THSLRingPicker.GetMaxSat: Integer;
begin
Result := FSLPicker.MaxSaturation;
end;
function THSLRingPicker.GetMaxLum: Integer;
begin
Result := FSLPicker.MaxLuminance;
end;
procedure THSLRingPicker.SetMaxHue(H: Integer);
begin
FRingPicker.MaxHue := H;
end;
procedure THSLRingPicker.SetMaxLum(L: Integer);
begin
FSLPicker.MaxLuminance := L;
end;
procedure THSLRingPicker.SetMaxSat(S: Integer);
begin
FSLPicker.MaxSaturation := S;
end;
end. end.

289
components/mbColorLib/HSVColorPicker.pas
View File

@ -19,7 +19,8 @@ uses
type type
THSVColorPicker = class(TmbColorPickerControl) THSVColorPicker = class(TmbColorPickerControl)
private private
FHue, FSat, FValue: integer; FHue, FSat, FValue: Double;
FMaxHue, FMaxSat, FMaxValue: Integer;
FSatCircColor, FHueLineColor: TColor; FSatCircColor, FHueLineColor: TColor;
FSelectedColor: TColor; FSelectedColor: TColor;
FShowSatCirc: boolean; FShowSatCirc: boolean;
@ -28,9 +29,15 @@ type
FChange: boolean; FChange: boolean;
FDoChange: boolean; FDoChange: boolean;
function RadHue(New: integer): integer; function RadHue(New: integer): integer;
procedure SetValue(V: integer); function GetHue: Integer;
function GetSat: Integer;
function GetValue: Integer;
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetHue(h: integer); procedure SetHue(h: integer);
procedure SetSat(s: integer); procedure SetSat(s: integer);
procedure SetValue(V: integer);
procedure SetSatCircColor(c: TColor); procedure SetSatCircColor(c: TColor);
procedure SetHueLineColor(c: TColor); procedure SetHueLineColor(c: TColor);
procedure DrawSatCirc; procedure DrawSatCirc;
@ -59,9 +66,12 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override; function GetColorAtPoint(x, y: integer): TColor; override;
published published
property Hue: integer read FHue write SetHue default 0; property Hue: integer read GetHue write SetHue;
property Saturation: integer read FSat write SetSat default 0; property Saturation: integer read GetSat write SetSat;
property Value: integer read FValue write SetValue default 255; 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 FMaxValue write SetMaxValue default 255;
property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver; property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray; property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property SelectedColor default clNone; property SelectedColor default clNone;
@ -88,9 +98,12 @@ begin
{$ELSE} {$ELSE}
SetInitialBounds(0, 0, 204, 204); SetInitialBounds(0, 0, 204, 204);
{$ENDIF} {$ENDIF}
FValue := 255; FMaxHue := 359;
FMaxSat := 255;
FMaxValue := 255;
FHue := 0; FHue := 0;
FSat := 0; FSat := 0;
FValue := 1.0;
FSatCircColor := clSilver; FSatCircColor := clSilver;
FHueLineColor := clGray; FHueLineColor := clGray;
FSelectedColor := clNone; FSelectedColor := clNone;
@ -137,35 +150,49 @@ end;
{ Outer loop: Y, Inner loop: X } { Outer loop: Y, Inner loop: X }
function THSVColorPicker.GetGradientColor2D(X, Y: Integer): TColor; function THSVColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
var var
xcoord, ycoord: Integer; dx, dy: Integer;
dSq, radiusSq: Integer; dSq, radiusSq: Integer;
radius, size: Integer; radius, size: Integer;
S, H, V: Integer; S, H, V: Double;
q: TRGBQuad; q: TRGBQuad;
begin begin
size := FGradientWidth; // or Height, they are the same... size := FGradientWidth; // or Height, they are the same...
radius := size div 2; radius := size div 2;
radiusSq := sqr(radius); radiusSq := sqr(radius);
xcoord := X - radius; dx := X - radius;
ycoord := Y - radius; dy := Y - radius;
dSq := sqr(xcoord) + sqr(ycoord); dSq := sqr(dx) + sqr(dy);
if dSq <= radiusSq then if dSq <= radiusSq then
begin begin
if radius <> 0 then if radius <> 0 then
S := round((255 * sqrt(dSq)) / radius) S := sqrt(dSq) / radius
//S := trunc((255 * sqrt(dSq)) / radius)
else else
S := 0; S := 0;
H := round( 180 * (1 + arctan2(xcoord, ycoord) / pi)); // wp: order (x,y) is correct! H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90; H := H + 90;
if H > 360 then H := H - 360; if H > 360 then H := H - 360;
Result := HSVtoColor(H, S, FValue); Result := HSVtoColor(H/360, S, FValue);
if WebSafe then if WebSafe then
Result := GetWebSafe(Result); Result := GetWebSafe(Result);
end else end else
Result := GetDefaultColor(dctBrush); Result := GetDefaultColor(dctBrush);
end; end;
function THSVColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function THSVColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function THSVColorPicker.GetValue: Integer;
begin
Result := round(FValue * FMaxValue);
end;
procedure THSVColorPicker.Resize; procedure THSVColorPicker.Resize;
begin begin
inherited; inherited;
@ -187,8 +214,8 @@ var
radius: integer; radius: integer;
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
r := -MulDiv(radius, FSat, 255); r := -FSat * radius;
angle := -FHue* pi / 180 - PI; angle := -(FHue * 2 + 1) * pi;
SinCos(angle, sinAngle, cosAngle); SinCos(angle, sinAngle, cosAngle);
mdx := round(cosAngle * r) + radius; mdx := round(cosAngle * r) + radius;
mdy := round(sinAngle * r) + radius; mdy := round(sinAngle * r) + radius;
@ -196,10 +223,10 @@ end;
procedure THSVColorPicker.SetHue(h: integer); procedure THSVColorPicker.SetHue(h: integer);
begin begin
Clamp(h, 0, 360); Clamp(h, 0, FMaxHue);
if FHue <> h then if GetHue() <> h then
begin begin
FHue := h; FHue := h / FMaxHue;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -209,10 +236,10 @@ end;
procedure THSVColorPicker.SetSat(s: integer); procedure THSVColorPicker.SetSat(s: integer);
begin begin
Clamp(s, 0, 255); Clamp(s, 0, FMaxSat);
if FSat <> s then if GetSat() <> s then
begin begin
FSat := s; FSat := s / FMaxSat;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -222,10 +249,10 @@ end;
procedure THSVColorPicker.SetValue(V: integer); procedure THSVColorPicker.SetValue(V: integer);
begin begin
Clamp(V, 0, 255); Clamp(V, 0, FMaxValue);
if FValue <> V then if GetValue() <> V then
begin begin
FValue := V; FValue := V / FMaxValue;
FManual := false; FManual := false;
CreateGradient; CreateGradient;
Invalidate; Invalidate;
@ -233,6 +260,36 @@ begin
end; end;
end; end;
procedure THSVColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetMaxValue(v: Integer);
begin
if v = FMaxValue then
exit;
FMaxValue := v;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetSatCircColor(c: TColor); procedure THSVColorPicker.SetSatCircColor(c: TColor);
begin begin
if FSatCircColor <> c then if FSatCircColor <> c then
@ -285,12 +342,12 @@ var
begin begin
if not FShowSatCirc then if not FShowSatCirc then
exit; exit;
if (FSat > 0) and (FSat < 255) then if (FSat > 0) and (FSat < 1.0) then
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
Canvas.Pen.Color := FSatCircColor; Canvas.Pen.Color := FSatCircColor;
Canvas.Brush.Style := bsClear; Canvas.Brush.Style := bsClear;
delta := MulDiv(radius, FSat, 255); delta := round(radius * FSat);
Canvas.Ellipse(radius - delta, radius - delta, radius + delta, radius + delta); Canvas.Ellipse(radius - delta, radius - delta, radius + delta, radius + delta);
end; end;
end; end;
@ -304,9 +361,9 @@ begin
if not FShowHueLine then if not FShowHueLine then
exit; exit;
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
if (FHue >= 0) and (FHue <= 360) then if (FHue >= 0) and (FHue <= 1.0) then
begin begin
angle := -FHue * pi / 180; angle := -FHue * 2 * pi;
SinCos(angle, sinAngle, cosAngle); SinCos(angle, sinAngle, cosAngle);
Canvas.Pen.Color := FHueLineColor; Canvas.Pen.Color := FHueLineColor;
Canvas.MoveTo(radius, radius); Canvas.MoveTo(radius, radius);
@ -329,33 +386,37 @@ end;
procedure THSVColorPicker.SelectionChanged(x, y: integer); procedure THSVColorPicker.SelectionChanged(x, y: integer);
var var
angle, distance, xDelta, yDelta, radius: integer; angle: Double;
dx, dy, r, radius: integer;
begin begin
if not PointInCircle(Point(x, y), Min(Width, Height)) then radius := Min(Width, Height) div 2;
dx := x - radius;
dy := y - radius;
r := round(sqrt(sqr(dx) + sqr(dy)));
if r > radius then // point outside circle
begin begin
FChange := false; FChange := false;
SetSelectedColor(clNone); SetSelectedColor(clNone);
FChange := true; FChange := true;
exit; exit;
end end;
else
FSelectedColor := clWhite; FSelectedColor := clWhite;
radius := Min(Width, Height) div 2; angle := 360 + 180*arctan2(-dy, dx) / pi; // wp: "-y, x" correct? The others have "x, y"
xDelta := x - radius;
yDelta := y - radius;
angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
if angle < 0 then if angle < 0 then
inc(angle, 360) angle := angle + 360
else if angle > 360 then else if angle > 360 then
dec(angle, 360); angle := angle - 360;
FChange := false; FChange := false;
SetHue(Angle); FHue := angle / 360;
distance := round(sqrt(sqr(xDelta) + sqr(yDelta))); if r > radius then
if distance >= radius then FSat := 1.0
SetSat(255)
else else
SetSat(MulDiv(distance, 255, radius)); FSat := r / radius;
FChange := true; FChange := true;
Invalidate;
end; end;
procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
@ -379,8 +440,10 @@ end;
procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
{$IFDEF DELPHI}
var var
R: TRect; R: TRect;
{$ENDIF}
begin begin
inherited; inherited;
if csDesigning in ComponentState then if csDesigning in ComponentState then
@ -389,11 +452,11 @@ begin
begin begin
mdx := x; mdx := x;
mdy := y; mdy := y;
{$IFDEF DELPHI}
R := ClientRect; R := ClientRect;
InflateRect(R, 1, 1); InflateRect(R, 1, 1);
R.TopLeft := ClientToScreen(R.TopLeft); R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight); R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R); ClipCursor(@R);
{$ENDIF} {$ENDIF}
FDoChange := true; FDoChange := true;
@ -434,10 +497,9 @@ function THSVColorPicker.GetSelectedColor: TColor;
begin begin
if FSelectedColor <> clNone then if FSelectedColor <> clNone then
begin begin
if not WebSafe then Result := HSVtoColor(FHue, FSat, FValue);
Result := HSVtoColor(FHue, FSat, FValue) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(HSVtoColor(FHue, FSat, FValue));
end end
else else
Result := clNone; Result := clNone;
@ -445,46 +507,44 @@ end;
function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor; function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor;
var var
angle, distance, xDelta, yDelta, radius: integer; angle: Double;
h, s: integer; dx, dy, r, radius: integer;
h, s: double;
begin begin
radius := Min(Width, Height) div 2; radius := Min(Width, Height) div 2;
xDelta := x - Radius; dx := x - Radius;
yDelta := y - Radius; dy := y - Radius;
angle := round(360 + 180*arctan2(-yDelta, xDelta) / pi);
if angle < 0 then r := round(sqrt(sqr(dx) + sqr(dy)));
inc(angle, 360) if r <= radius then
else if angle > 360 then
dec(angle, 360);
h := angle;
distance := round(sqrt(sqr(xDelta) + sqr(yDelta)));
if distance >= radius then
s := 255
else
s := MulDiv(distance, 255, radius);
if PointInCircle(Point(mx, my), Min(Width, Height)) then
begin begin
if not WebSafe then angle := 360 + 180 * arctan2(-dy, dx) / pi;
Result := HSVtoColor(h, s, FValue) if angle < 0 then
else angle := angle + 360
Result := GetWebSafe(HSVtoColor(h, s, FValue)); else if angle > 360 then
end angle := angle - 360;
else h := angle / 360;
s := r / radius;
Result := HSVtoColor(h, s, FValue);
if WebSafe then
Result := GetWebSafe(Result);
end else
Result := clNone; Result := clNone;
end; end;
procedure THSVColorPicker.SetSelectedColor(c: TColor); procedure THSVColorPicker.SetSelectedColor(c: TColor);
var var
changeSave: boolean; changeSave: boolean;
h, s, v: Double;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then c := GetWebSafe(c);
changeSave := FChange; changeSave := FChange;
FManual := false; FManual := false;
Fchange := false; FChange := false;
SetValue(GetVValue(c)); RGBtoHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue);
SetHue(GetHValue(c));
SetSat(GetSValue(c));
FSelectedColor := c; FSelectedColor := c;
UpdateCoords;
Invalidate;
FChange := changeSave; FChange := changeSave;
if FChange and Assigned(FOnChange) then FOnChange(Self); if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true; FChange := true;
@ -492,67 +552,29 @@ end;
function THSVColorPicker.RadHue(New: integer): integer; function THSVColorPicker.RadHue(New: integer): integer;
begin begin
if New < 0 then New := New + 360; if New < 0 then New := New + (FMaxHue + 1);
if New > 360 then New := New - 360; if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New; Result := New;
end; end;
procedure THSVColorPicker.CNKeyDown( procedure THSVColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var var
Shift: TShiftState; shift: TShiftState;
FInherited: boolean; FInherited: boolean;
delta: Integer;
begin begin
FInherited := false; FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData); shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then if ssCtrl in shift then
case Message.CharCode of delta := 10
VK_LEFT:
begin
FChange := false;
SetHue(RadHue(FHue + 1));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
begin
FChange := false;
SetHue(RadHue(FHue - 1));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_UP:
begin
FChange := false;
if FSat + 1 <= 255 then
SetSat(FSat + 1);
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_DOWN:
begin
FChange := false;
if FSat - 1 >= 0 then
SetSat(FSat - 1);
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
else else
begin delta := 1;
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of case Message.CharCode of
VK_LEFT: VK_LEFT:
begin begin
FChange := false; FChange := false;
SetHue(RadHue(FHue + 10)); SetHue(RadHue(GetHue() + delta));
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -560,7 +582,7 @@ begin
VK_RIGHT: VK_RIGHT:
begin begin
FChange := false; FChange := false;
SetHue(RadHue(FHue - 10)); SetHue(RadHue(GetHue() - delta));
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -568,8 +590,7 @@ begin
VK_UP: VK_UP:
begin begin
FChange := false; FChange := false;
if FSat + 10 <= 255 then SetSat(GetSat() + delta);
SetSat(FSat + 10);
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -577,8 +598,7 @@ begin
VK_DOWN: VK_DOWN:
begin begin
FChange := false; FChange := false;
if FSat - 10 >= 0 then SetSat(GetSat() - delta);
SetSat(FSat - 10);
FChange := true; FChange := true;
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
@ -589,9 +609,10 @@ begin
inherited; inherited;
end; end;
end; end;
if not FInherited then
if Assigned(OnKeyDown) then if not FInherited then
OnKeyDown(Self, Message.CharCode, Shift); if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end; end;
end. end.

11
components/mbColorLib/KColorPicker.pas
View File

@ -54,7 +54,7 @@ constructor TKColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FCyan := 0; FCyan := 0;
FMagenta := 0; FMagenta := 0;
FYellow := 0; FYellow := 0;
@ -70,7 +70,7 @@ end;
function TKColorPicker.GetGradientColor(AValue: Integer): TColor; function TKColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, AValue); Result := CMYKtoColor(FCyan, FMagenta, FYellow, AValue);
end; end;
procedure TKColorPicker.SetBlack(k: integer); procedure TKColorPicker.SetBlack(k: integer);
@ -158,10 +158,9 @@ end;
function TKColorPicker.GetSelectedColor: TColor; function TKColorPicker.GetSelectedColor: TColor;
begin begin
if not WebSafe then Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
end; end;
function TKColorPicker.GetSelectedValue: integer; function TKColorPicker.GetSelectedValue: integer;

191
components/mbColorLib/LColorPicker.pas
View File

@ -18,12 +18,19 @@ uses
type type
TLColorPicker = class(TmbTrackBarPicker) TLColorPicker = class(TmbTrackBarPicker)
private private
FHue, FSat, FLuminance: integer; FHue, FSat, FLuminance: Double;
function ArrowPosFromLum(l: integer): integer; FMaxHue, FMaxSat, FMaxLum: Integer;
function ArrowPosFromLum(L: integer): integer;
function LumFromArrowPos(p: integer): integer; function LumFromArrowPos(p: integer): integer;
procedure SetHue(h: integer); function GetHue: Integer;
procedure SetSat(s: integer); function GetSat: Integer;
procedure SetLuminance(l: integer); function GetLuminance: Integer;
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLuminance(L: integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxSat(S: Integer);
procedure SetMaxLum(L: Integer);
function GetSelectedColor: TColor; function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor); procedure SetSelectedColor(c: TColor);
protected protected
@ -34,9 +41,12 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Hue: integer read FHue write SetHue default 0; property Hue: integer read GetHue write SetHue;
property Saturation: integer read FSat write SetSat default 240; property Saturation: integer read GetSat write SetSat;
property Luminance: integer read FLuminance write SetLuminance default 120; property Luminance: integer read GetLuminance write SetLuminance;
property MaxHue: Integer read FMaxHue write SetmaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
end; end;
@ -50,13 +60,15 @@ uses
constructor TLColorPicker.Create(AOwner: TComponent); constructor TLColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FMaxHue := 359;
FGradientHeight := 12; FMaxSat := 240;
FMaxLum := 240;
FGradientWidth := FMaxLum + 1;
FGradientHeight := 1;
FHue := 0; FHue := 0;
FSat := MaxSat; FSat := FMaxSat;
FArrowPos := ArrowPosFromLum(MaxLum div 2);
FChange := false; FChange := false;
SetLuminance(MaxLum div 2); SetLuminance(FMaxLum div 2);
HintFormat := 'Luminance: %value (selected)'; HintFormat := 'Luminance: %value (selected)';
FManual := false; FManual := false;
FChange := true; FChange := true;
@ -64,15 +76,30 @@ end;
function TLColorPicker.GetGradientColor(AValue: Integer): TColor; function TLColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := HSLRangeToRGB(FHue, FSat, AValue); Result := HSLToRGB(FHue, FSat, AValue/FMaxLum);
end; end;
procedure TLColorPicker.SetHue(h: integer); function TLColorPicker.GetHue: Integer;
begin begin
Clamp(h, 0, MaxHue); Result := Round(FHue * FMaxHue);
if FHue <> h then end;
function TLColorPicker.GetLuminance: Integer;
begin
Result := Round(FLuminance * FMaxLum);
end;
function TLColorPicker.GetSat: Integer;
begin
Result := Round(FSat * FMaxSat);
end;
procedure TLColorPicker.SetHue(H: integer);
begin
Clamp(H, 0, FMaxHue);
if GetHue() <> H then
begin begin
FHue := h; FHue := H / FMaxHue;
FManual := false; FManual := false;
CreateGradient; CreateGradient;
Invalidate; Invalidate;
@ -80,12 +107,56 @@ begin
end; end;
end; end;
procedure TLColorPicker.SetSat(s: integer); procedure TLColorPicker.SetLuminance(L: integer);
begin begin
Clamp(s, 0, MaxSat); Clamp(L, 0, FMaxLum);
if FSat <> s then if GetLuminance() <> L then
begin begin
FSat := s; FLuminance := L / FMaxLum;
FArrowPos := ArrowPosFromLum(L);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TLColorPicker.SetMaxHue(H: Integer);
begin
if H = FMaxHue then
exit;
FMaxHue := H;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TLColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
FGradientWidth := FMaxLum + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TLColorPicker.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
FMaxSat := S;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TLColorPicker.SetSat(S: integer);
begin
Clamp(S, 0, FMaxSat);
if GetSat() <> S then
begin
FSat := S / FMaxSat;
FManual := false; FManual := false;
CreateGradient; CreateGradient;
Invalidate; Invalidate;
@ -93,19 +164,18 @@ begin
end; end;
end; end;
function TLColorPicker.ArrowPosFromLum(l: integer): integer; function TLColorPicker.ArrowPosFromLum(L: integer): integer;
var var
a: integer; a: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
begin begin
a := Round(((Width - 12)/MaxLum)*l); a := Round((Width - 12) * L / FMaxLum);
if a > Width - FLimit then a := Width - FLimit; if a > Width - FLimit then a := Width - FLimit;
end end
else else
begin begin
l := MaxLum - l; a := Round((Height - 12) * (FMaxLum - L) / FMaxLum);
a := Round(((Height - 12)/MaxLum)*l);
if a > Height - FLimit then a := Height - FLimit; if a > Height - FLimit then a := Height - FLimit;
end; end;
if a < 0 then a := 0; if a < 0 then a := 0;
@ -117,88 +187,73 @@ var
L: integer; L: integer;
begin begin
if Layout = lyHorizontal then if Layout = lyHorizontal then
L := Round(p/((Width - 12)/MaxLum)) L := Round(p / (Width - 12) * FMaxLum)
else else
L := Round(MaxLum - p/((Height - 12)/MaxLum)); L := Round(MaxLum - p /(Height - 12) * FMaxLum);
Clamp(L, 0, MaxLum); Clamp(L, 0, FMaxLum);
Result := L; Result := L;
end; end;
procedure TLColorPicker.SetLuminance(L: integer);
begin
Clamp(L, 0, MaxLum);
if FLuminance <> L then
begin
FLuminance := L;
FArrowPos := ArrowPosFromLum(L);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TLColorPicker.GetSelectedColor: TColor; function TLColorPicker.GetSelectedColor: TColor;
begin begin
if not WebSafe then Result := HSLToRGB(FHue, FSat, FLuminance);
Result := HSLRangeToRGB(FHue, FSat, FLuminance) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(HSLRangeToRGB(FHue, FSat, FLuminance));
end; end;
function TLColorPicker.GetSelectedValue: integer; function TLColorPicker.GetSelectedValue: integer;
begin begin
Result := FLuminance; Result := GetLuminance();
end; end;
procedure TLColorPicker.SetSelectedColor(c: TColor); procedure TLColorPicker.SetSelectedColor(c: TColor);
var
h1, s1, l1: integer;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then c := GetWebSafe(c);
RGBtoHSLRange(c, h1, s1, l1); ColortoHSL(c, FHue, FSat, FLuminance);
Fchange := false; FChange := false;
SetHue(h1);
SetSat(s1);
SetLuminance(l1);
FChange := true;
FManual := false; FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self); if FChange and Assigned(OnChange) then OnChange(Self);
end; end;
function TLColorPicker.GetArrowPos: integer; function TLColorPicker.GetArrowPos: integer;
begin begin
Result := ArrowPosFromLum(FLuminance); if FMaxLum = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromLum(GetLuminance());
end; end;
procedure TLColorPicker.Execute(tbaAction: integer); procedure TLColorPicker.Execute(tbaAction: integer);
begin begin
case tbaAction of case tbaAction of
TBA_Resize: TBA_Resize:
SetLuminance(FLuminance); SetLuminance(GetLuminance());
TBA_MouseMove: TBA_MouseMove:
FLuminance := LumFromArrowPos(FArrowPos); SetLuminance(LumFromArrowPos(FArrowPos));
TBA_MouseDown: TBA_MouseDown:
Fluminance := LumFromArrowPos(FArrowPos); SetLuminance(LumFromArrowPos(FArrowPos));
TBA_MouseUp: TBA_MouseUp:
Fluminance := LumFromArrowPos(FArrowPos); SetLuminance(LumFromArrowPos(FArrowPos));
TBA_WheelUp: TBA_WheelUp:
SetLuminance(FLuminance + Increment); SetLuminance(GetLuminance() + Increment);
TBA_WheelDown: TBA_WheelDown:
SetLuminance(FLuminance - Increment); SetLuminance(GetLuminance() - Increment);
TBA_VKRight: TBA_VKRight:
SetLuminance(FLuminance + Increment); SetLuminance(GetLuminance() + Increment);
TBA_VKCtrlRight: TBA_VKCtrlRight:
SetLuminance(MaxLum); SetLuminance(FMaxLum);
TBA_VKLeft: TBA_VKLeft:
SetLuminance(FLuminance - Increment); SetLuminance(GetLuminance() - Increment);
TBA_VKCtrlLeft: TBA_VKCtrlLeft:
SetLuminance(0); SetLuminance(0);
TBA_VKUp: TBA_VKUp:
SetLuminance(FLuminance + Increment); SetLuminance(GetLuminance() + Increment);
TBA_VKCtrlUp: TBA_VKCtrlUp:
SetLuminance(MaxLum); SetLuminance(FMaxLum);
TBA_VKDown: TBA_VKDown:
SetLuminance(FLuminance - Increment); SetLuminance(GetLuminance() - Increment);
TBA_VKCtrlDown: TBA_VKCtrlDown:
SetLuminance(0); SetLuminance(0);
else else

11
components/mbColorLib/MColorPicker.pas
View File

@ -54,7 +54,7 @@ constructor TMColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FCyan := 0; FCyan := 0;
FMagenta := 255; FMagenta := 255;
FYellow := 0; FYellow := 0;
@ -71,7 +71,7 @@ end;
function TMColorPicker.GetGradientColor(AValue: Integer): TColor; function TMColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, AValue, FYellow, FBlack); Result := CMYKtoColor(FCyan, AValue, FYellow, FBlack);
end; end;
procedure TMColorPicker.SetMagenta(m: integer); procedure TMColorPicker.SetMagenta(m: integer);
@ -159,10 +159,9 @@ end;
function TMColorPicker.GetSelectedColor: TColor; function TMColorPicker.GetSelectedColor: TColor;
begin begin
if not WebSafe then Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
end; end;
function TMColorPicker.GetSelectedValue: integer; function TMColorPicker.GetSelectedValue: integer;

22
components/mbColorLib/OfficeMoreColorsDialog.pas
View File

@ -187,8 +187,8 @@ begin
(ERed.Focused {$IFDEF DELPHI} or ERed.Button.Focused{$ENDIF}) then (ERed.Focused {$IFDEF DELPHI} or ERed.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.RValue := ERed.Value; HSL.Red := ERed.Value;
SLH.RValue := ERed.Value; SLH.Red := ERed.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
dec(FLockChange); dec(FLockChange);
end; end;
@ -200,8 +200,8 @@ begin
(EGreen.Focused {$IFDEF DELPHI}or EGreen.Button.Focused{$ENDIF}) then (EGreen.Focused {$IFDEF DELPHI}or EGreen.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.GValue := EGreen.Value; HSL.Green := EGreen.Value;
SLH.GValue := EGreen.Value; SLH.Green := EGreen.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
dec(FLockChange); dec(FLockChange);
end; end;
@ -213,8 +213,8 @@ begin
(EBlue.Focused {$IFDEF DELPHI} or EBlue.Button.Focused{$ENDIF}) then (EBlue.Focused {$IFDEF DELPHI} or EBlue.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.BValue := EBlue.Value; HSL.Blue := EBlue.Value;
SLH.BValue := EBlue.Value; SLH.Blue := EBlue.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value); NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
dec(FLockChange); dec(FLockChange);
end; end;
@ -226,8 +226,8 @@ begin
(EHue.Focused {$IFDEF DELPHI} or EHue.Button.Focused{$ENDIF}) then (EHue.Focused {$IFDEF DELPHI} or EHue.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.HValue := EHue.Value; HSL.Hue := EHue.Value;
SLH.HValue := EHue.Value; SLH.Hue := EHue.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
dec(FLockChange); dec(FLockChange);
end; end;
@ -239,8 +239,8 @@ begin
(ESat.Focused {$IFDEF DELPHI}or ESat.Button.Focused{$ENDIF}) then (ESat.Focused {$IFDEF DELPHI}or ESat.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.SValue := ESat.Value; HSL.Saturation := ESat.Value;
SLH.SValue := ESat.Value; SLH.Saturation := ESat.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
dec(FLockChange); dec(FLockChange);
end; end;
@ -252,7 +252,7 @@ begin
(ELum.Focused {$IFDEF DELPHI} or ELum.Button.Focused{$ENDIF}) then (ELum.Focused {$IFDEF DELPHI} or ELum.Button.Focused{$ENDIF}) then
begin begin
inc(FLockChange); inc(FLockChange);
HSL.LValue := ELum.Value; HSL.Luminance := ELum.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value); NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
dec(FLockChange); dec(FLockChange);
end; end;

4
components/mbColorLib/PalUtils.pas
View File

@ -588,13 +588,13 @@ begin
1: //HSB - HSV 1: //HSB - HSV
Result := HSVToColor(Round(w/182.04), Round(x/655.35), Round(y/655.35)); Result := HSVToColor(Round(w/182.04), Round(x/655.35), Round(y/655.35));
2: //CMYK 2: //CMYK
Result := CMYKToTColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35)); Result := CMYKToColor(Round(100-w/55.35), Round(100-x/655.35), Round(100-y/655.35), Round(100-z/655.35));
7: //Lab 7: //Lab
Result := LabToRGB(w/100, x/100, y/100); Result := LabToRGB(w/100, x/100, y/100);
8: //Grayscale 8: //Grayscale
Result := RGB(Round(w/39.0625), Round(w/39.0625), Round(w/39.0625)); Result := RGB(Round(w/39.0625), Round(w/39.0625), Round(w/39.0625));
9: //Wide CMYK 9: //Wide CMYK
Result := CMYKToTColor(w div 100, x div 100, y div 100, z div 100) Result := CMYKToColor(w div 100, x div 100, y div 100, z div 100)
else //unknown else //unknown
Result := RGB(w div 256, x div 256, y div 256); Result := RGB(w div 256, x div 256, y div 256);
end; end;

10
components/mbColorLib/RColorPicker.pas
View File

@ -38,8 +38,8 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
published published
property Red: integer read FRed write SetRed default 255; property Red: integer read FRed write SetRed default 255;
property Green: integer read FGreen write SetGreen default 122; property Green: integer read FGreen write SetGreen default 128;
property Blue: integer read FBlue write SetBlue default 122; property Blue: integer read FBlue write SetBlue default 128;
property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed; property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
property Layout default lyVertical; property Layout default lyVertical;
end; end;
@ -57,10 +57,10 @@ constructor TRColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FGradientWidth := 256;
FGradientHeight := 12; FGradientHeight := 1;
FRed := 255; FRed := 255;
FGreen := 122; FGreen := 128;
FBlue := 122; FBlue := 128;
FArrowPos := ArrowPosFromRed(255); FArrowPos := ArrowPosFromRed(255);
FChange := false; FChange := false;
Layout := lyVertical; Layout := lyVertical;

80
components/mbColorLib/RGBCMYKUtils.pas
View File

@ -2,22 +2,30 @@ unit RGBCMYKUtils;
interface interface
// Activate only one of these defines - see comments below
{.$DEFINE CMYK_FORMULA_1} // Original formula used by mbColorLib
{$DEFINE CMYK_FORMULA_2} // Result agrees with OpenOffice
uses uses
{$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF} {$IFDEF FPC}LCLIntf,{$ELSE} Windows,{$ENDIF}
Graphics, Math; Graphics, Math;
function CMYtoTColor(C, M, Y: integer): TColor; function CMYtoColor(C, M, Y: integer): TColor;
procedure RGBtoCMY(clr: TColor; var C, M, Y: integer); procedure RGBtoCMY(clr: TColor; var C, M, Y: integer);
function CMYKToTColor (C, M, Y, K: integer): TColor;
procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); function CMYKToColor (C, M, Y, K: Integer): TColor;
procedure ColorToCMYK(clr: TColor; out C, M, Y, K: integer);
function GetCValue(c: TColor): integer; function GetCValue(c: TColor): integer;
function GetMValue(c: TColor): integer; function GetMValue(c: TColor): integer;
function GetYValue(c: TColor): integer; function GetYValue(c: TColor): integer;
function GetKValue(c: TColor): integer; function GetKValue(c: TColor): integer;
implementation implementation
function CMYtoTColor(C, M, Y: integer): TColor; function CMYtoColor(C, M, Y: integer): TColor;
begin begin
Result := RGB(255 - C, 255 - M, 255 - Y); Result := RGB(255 - C, 255 - M, 255 - Y);
end; end;
@ -29,12 +37,20 @@ begin
Y := 255 - GetBValue(clr); Y := 255 - GetBValue(clr);
end; end;
function CMYKToTColor (C, M, Y, K: integer): TColor; {$IFDEF CMYK_FORMULA_1}
//==============================================================================
// Original formulas of mbColorLib
//==============================================================================
function CMYKtoColor(C, M, Y, K: Integer): TColor;
begin begin
Result := RGB(255 - (C + K), 255 - (M + K), 255 - (Y + K)); Result := RGBtoColor(
(255 - (C + K)) mod 255, // wp: added mod 255, otherwise the result is nonsense
(255 - (M + K)) mod 255,
(255 - (Y + K)) mod 255
);
end; end;
procedure ColorToCMYK(clr: TColor; var C, M, Y, K: integer); procedure ColorToCMYK(clr: TColor; out C, M, Y, K: integer);
begin begin
C := 255 - GetRValue(clr); C := 255 - GetRValue(clr);
M := 255 - GetGValue(clr); M := 255 - GetGValue(clr);
@ -44,6 +60,56 @@ begin
M := M - K; M := M - K;
Y := Y - K; Y := Y - K;
end; end;
{$ENDIF}
{$IFDEF CMYK_FORMULA_2}
//==============================================================================
// Other formulas
// http://www.rapidtables.com/convert/color/cmyk-to-rgb.htm
// or https://stackoverflow.com/questions/2426432/convert-rgb-color-to-cmyk
//
// Result agrees with OpenOffice.
//==============================================================================
function CMYKtoColor(C, M, Y, K: Integer): TColor;
begin
Result := RGBtoColor(
(255-C) * (255-K) div 255,
(255-M) * (255-K) div 255,
(255-Y) * (255-K) div 255
);
end;
procedure ColorToCMYK(clr: TColor; out C, M, Y, K: Integer);
var
r, g, b: Integer;
r1, g1, b1, c1, m1, y1, k1: Double;
begin
r := GetRValue(clr);
g := GetGValue(clr);
b := GetBValue(clr);
if (r = 0) and (g = 0) and (b = 0) then
begin
C := 0;
M := 0;
Y := 0;
K := 1;
exit;
end;
r1 := r / 255;
g1 := g / 255;
b1 := b / 255;
k1 := MinValue([1-r1, 1-g1, 1-b1]);
c1 := (1 - r1 - k1) / (1 - k1);
m1 := (1 - g1 - k1) / (1 - k1);
y1 := (1 - b1 - k1) / (1 - k1);
C := round(255 * c1);
M := round(255 * m1);
Y := round(255 * y1);
K := round(255 * k1);
end;
{$ENDIF}
//==============================================================================
function GetCValue(c: TColor): integer; function GetCValue(c: TColor): integer;
var var

148
components/mbColorLib/RGBHSLUtils.pas
View File

@ -15,17 +15,23 @@ uses
Graphics, Math, Scanlines; Graphics, Math, Scanlines;
var //set these variables to your needs, e.g. 360, 255, 255 var //set these variables to your needs, e.g. 360, 255, 255
MaxHue: integer = 359; //239; MaxHue: integer = 359;
MaxSat: integer = 100; //240; MaxSat: integer = 240;
MaxLum: integer = 100; //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 HSLtoRGB (H, S, L: double): TColor;
function HSLRangeToRGB (H, S, L: integer): TColor;
procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer);
function GetHValue(AColor: TColor): integer; function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer; function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): integer; function GetLValue(AColor: TColor): integer;
//procedure Clamp(var Input: integer; Min, Max: integer);
function HSLToRGBTriple(H, S, L : integer) : TRGBTriple; function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad; function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer); procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
@ -35,6 +41,92 @@ implementation
uses uses
mbUtils; 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; function HSLtoRGB(H, S, L: double): TColor;
var var
M1, M2: double; M1, M2: double;
@ -89,7 +181,45 @@ begin
Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum); Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end; end;
procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1: integer); //==============================================================================
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 var
R, G, B, D, Cmax, Cmin, h, s, l: double; R, G, B, D, Cmax, Cmin, h, s, l: double;
begin begin
@ -131,6 +261,8 @@ begin
L1 := round(L * MaxLum); L1 := round(L * MaxLum);
end; end;
// =============================================================================
function GetHValue(AColor: TColor): integer; function GetHValue(AColor: TColor): integer;
var var
d, h: integer; d, h: integer;

2
components/mbColorLib/SColorPicker.pas
View File

@ -65,7 +65,7 @@ begin
FMaxSat := 255; FMaxSat := 255;
FMaxVal := 255; FMaxVal := 255;
FGradientWidth := FMaxSat + 1; FGradientWidth := FMaxSat + 1;
FGradientHeight := 12; FGradientHeight := 1;
FChange := false; FChange := false;
FHue := 0; FHue := 0;
FVal := 1.0; FVal := 1.0;

307
components/mbColorLib/SLColorPicker.pas
View File

@ -18,14 +18,21 @@ uses
type type
TSLColorPicker = class(TmbColorPickerControl) TSLColorPicker = class(TmbColorPickerControl)
private private
FHue, FSat, FLum: integer; FHue, FSat, FLum: Double;
FMaxHue, FMaxSat, FMaxLum: integer;
FChange: boolean; FChange: boolean;
procedure DrawMarker(x, y: integer); procedure DrawMarker(x, y: integer);
procedure SelectionChanged(x, y: integer); procedure SelectionChanged(x, y: integer);
procedure UpdateCoords; procedure UpdateCoords;
procedure SetHue(h: integer); function GetHue: Integer;
procedure SetSat(s: integer); function GetLum: Integer;
procedure SetLum(l: integer); function GetSat: Integer;
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
protected protected
function GetGradientColor2D(X, Y: Integer): TColor; override; function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: TColor; override; function GetSelectedColor: TColor; override;
@ -43,9 +50,12 @@ type
function GetColorAtPoint(x, y: integer): TColor; override; function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor; property ColorUnderCursor;
published published
property Hue: integer read FHue write SetHue default 0; property Hue: integer read GetHue write SetHue;
property Saturation: integer read FSat write SetSat default 0; property Saturation: integer read GetSat write SetSat;
property Luminance: integer read FLum write SetLum default 255; property Luminance: integer read GetLum write SetLum;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240;
property SelectedColor default clWhite; property SelectedColor default clWhite;
property MarkerStyle default msCircle; property MarkerStyle default msCircle;
property OnChange; property OnChange;
@ -61,31 +71,29 @@ uses
constructor TSLColorPicker.Create(AOwner: TComponent); constructor TSLColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 256; FMaxHue := 359;
FGradientHeight := 256; FMaxSat := 240;
FMaxLum := 240;
FGradientWidth := FMaxSat + 1; // x --> Saturation
FGradientHeight := FMaxLum + 1; // y --> Luminance
{$IFDEF DELPHI} {$IFDEF DELPHI}
Width := 255; Width := 255;
Height := 255; Height := 255;
{$ELSE} {$ELSE}
SetInitialBounds(0, 0, 256, 256); SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
{$ENDIF} {$ENDIF}
MaxHue := 360; FHue := 0.0;
MaxSat := 255; FSat := 0.0;
MaxLum := 255; FLum := 1.0;
FHue := 0;
FSat := 0;
FLum := 255;
FChange := true; FChange := true;
MarkerStyle := msCircle; MarkerStyle := msCircle;
end; end;
{ This picker has Saturation along the X and Luminance along the Y axis. } { This picker has Saturation along the X and Luminance along the Y axis. }
function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor; function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
var
q: TRGBQuad;
begin begin
q := HSLtoRGBQuad(FHue, x, 255-y); Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum);
Result := RGB(q.rgbRed, q.rgbGreen, q.rgbBlue); // Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum);
end; end;
procedure TSLColorPicker.Resize; procedure TSLColorPicker.Resize;
@ -103,15 +111,15 @@ end;
procedure TSLColorPicker.UpdateCoords; procedure TSLColorPicker.UpdateCoords;
begin begin
mdx := MulDiv(FSat, Width, 255); mdx := round(FSat * (Width - 1));
mdy := MulDiv(255-FLum, Height, 255); mdy := round((1.0 - FLum) * (Height - 1));
end; end;
procedure TSLColorPicker.DrawMarker(x, y: integer); procedure TSLColorPicker.DrawMarker(x, y: integer);
var var
c: TColor; c: TColor;
begin begin
c := not GetColorAtPoint(x, y); c := not GetColorAtPoint(x, y); // "not" --> invert color bits
InternalDrawMarker(x, y, c); InternalDrawMarker(x, y, c);
end; end;
@ -122,12 +130,27 @@ begin
DrawMarker(mdx, mdy); DrawMarker(mdx, mdy);
end; end;
procedure TSLColorPicker.SetHue(h: integer); function TSLColorPicker.GetHue: Integer;
begin begin
Clamp(h, 0, 360); Result := round(FHue * FMaxHue);
if FHue <> h then end;
function TSLColorPicker.GetLum: Integer;
begin
Result := round(FLum * FMaxLum);
end;
function TSLColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
procedure TSLColorPicker.SetHue(H: integer);
begin
Clamp(H, 0, FMaxHue);
if GetHue() <> H then
begin begin
FHue := h; FHue := h / FMaxHue;
FManual := false; FManual := false;
CreateGradient; CreateGradient;
UpdateCoords; UpdateCoords;
@ -136,12 +159,12 @@ begin
end; end;
end; end;
procedure TSLColorPicker.SetSat(s: integer); procedure TSLColorPicker.SetSat(S: integer);
begin begin
Clamp(s, 0, 255); Clamp(S, 0, FMaxSat);
if FSat <> s then if GetSat() <> S then
begin begin
FSat := s; FSat := S / FMaxSat;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -151,10 +174,10 @@ end;
procedure TSLColorPicker.SetLum(L: integer); procedure TSLColorPicker.SetLum(L: integer);
begin begin
Clamp(L, 0, 255); Clamp(L, 0, FMaxLum);
if FLum <> L then if GetLum() <> L then
begin begin
FLum := L; FLum := L / FMaxLum;
FManual := false; FManual := false;
UpdateCoords; UpdateCoords;
Invalidate; Invalidate;
@ -162,13 +185,53 @@ begin
end; end;
end; end;
procedure TSLColorPicker.SetMaxHue(H: Integer);
begin
if H = FMaxHue then
exit;
FMaxHue := H;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSLColorPicker.SetMaxLum(L: Integer);
begin
if L = FMaxLum then
exit;
FMaxLum := L;
FGradientHeight := FMaxLum + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure TSLColorPicker.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 TSLColorPicker.SelectionChanged(x, y: integer); procedure TSLColorPicker.SelectionChanged(x, y: integer);
begin begin
FChange := false; FChange := false;
// SetSat(MulDiv(255, x, Width)); // SetSat(MulDiv(255, x, Width));
// SetLum(MulDiv(255, Height - y, Height)); // SetLum(MulDiv(255, Height - y, Height));
FSat := x / (Width - 1);
FLum := (Height - y - 1) / (Height - 1);
FManual := false;
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
{
SetSat(MulDiv(255, x, Width - 1)); SetSat(MulDiv(255, x, Width - 1));
SetLum(MulDiv(255, Height - y -1, Height - 1)); SetLum(MulDiv(255, Height - y -1, Height - 1));
}
FChange := true; FChange := true;
end; end;
@ -192,8 +255,10 @@ end;
procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
{$IFDEF DELPHI}
var var
R: TRect; R: TRect;
{$ENDIF}
begin begin
inherited; inherited;
if csDesigning in ComponentState then if csDesigning in ComponentState then
@ -202,15 +267,15 @@ begin
begin begin
mdx := x; mdx := x;
mdy := y; mdy := y;
{$IFDEF DELPHI}
R := ClientRect; R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft); R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight); R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R); ClipCursor(@R);
{$ENDIF} {$ENDIF}
SelectionChanged(X, Y); SelectionChanged(X, Y);
FManual := true; // FManual := true;
if Assigned(FOnChange) then FOnChange(Self); // if Assigned(FOnChange) then FOnChange(Self);
end; end;
SetFocus; SetFocus;
end; end;
@ -225,139 +290,97 @@ begin
mdx := x; mdx := x;
mdy := y; mdy := y;
SelectionChanged(X, Y); SelectionChanged(X, Y);
FManual := true; // FManual := true;
if Assigned(FOnChange) then FOnChange(Self); // if Assigned(FOnChange) then FOnChange(Self);
end; end;
end; end;
procedure TSLColorPicker.SetSelectedColor(c: TColor); procedure TSLColorPicker.SetSelectedColor(c: TColor);
var var
h, s, l: integer; h, s, l: Double;
begin begin
if WebSafe then c := GetWebSafe(c); if WebSafe then c := GetWebSafe(c);
FManual := false; FManual := false;
FChange := false; FChange := false;
RGBTripleToHSL(RGBtoRGBTriple(GetRValue(c), GetGValue(c), GetBValue(c)), h, s, l); ColorToHSL(c, FHue, FSat, FLum);
SetHue(h); FManual := false;
SetSat(s); UpdateCoords;
SetLum(l); Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self); if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true; FChange := true;
end; end;
function TSLColorPicker.GetSelectedColor: TColor; function TSLColorPicker.GetSelectedColor: TColor;
var
triple: TRGBTriple;
begin begin
triple := HSLToRGBTriple(FHue, FSat, FLum); Result := HSLtoRGB(FHue, FSat, FLum);
if not WebSafe then if WebSafe then
Result := RGBTripleToColor(triple) Result := GetWebSafe(Result);
else
Result := GetWebSafe(RGBTripleToColor(triple));
end; end;
function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor; function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
triple: TRGBTriple;
begin begin
triple := HSLToRGBTriple(FHue, MulDiv(255, x, Width), MulDiv(255, Height - y, Height)); Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1));
if not WebSafe then if WebSafe then
Result := RGBTripleToColor(triple) Result := GetWebSafe(Result);
else
Result := GetWebSafe(RGBTripleToColor(triple));
end; end;
procedure TSLColorPicker.CNKeyDown( procedure TSLColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} ); var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var var
Shift: TShiftState; Shift: TShiftState;
FInherited: boolean; FInherited: boolean;
delta: Integer;
begin begin
FInherited := false; FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData); Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then if ssCtrl in Shift then
case Message.CharCode of delta := 10
VK_LEFT:
if not (mdx - 1 < 0) then
begin
Dec(mdx, 1);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
if not (mdx + 1 > Width) then
begin
Inc(mdx, 1);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_UP:
if not (mdy - 1 < 0) then
begin
Dec(mdy, 1);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_DOWN:
if not (mdy + 1 > Height) then
begin
Inc(mdy, 1);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
else else
begin delta := 1;
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of case Message.CharCode of
VK_LEFT: VK_LEFT:
if not (mdx - 10 < 0) then if not (mdx - delta < 0) then
begin begin
Dec(mdx, 10); Dec(mdx, delta);
SelectionChanged(mdx, mdy); SelectionChanged(mdx, mdy);
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
end; end;
VK_RIGHT: VK_RIGHT:
if not (mdx + 10 > Width) then if not (mdx + delta > Width) then
begin begin
Inc(mdx, 10); Inc(mdx, delta);
SelectionChanged(mdx, mdy); SelectionChanged(mdx, mdy);
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
end; end;
VK_UP: VK_UP:
if not (mdy - 10 < 0) then if not (mdy - delta < 0) then
begin begin
Dec(mdy, 10); Dec(mdy, delta);
SelectionChanged(mdx, mdy); SelectionChanged(mdx, mdy);
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
end; end;
VK_DOWN: VK_DOWN:
if not (mdy + 10 > Height) then if not (mdy + delta > Height) then
begin begin
Inc(mdy, 10); Inc(mdy, delta);
SelectionChanged(mdx, mdy); SelectionChanged(mdx, mdy);
FManual := true; FManual := true;
if Assigned(FOnChange) then FOnChange(Self); if Assigned(FOnChange) then FOnChange(Self);
end; end;
else else
begin begin
FInherited := true; FInherited := true;
inherited; inherited;
end; end;
end; end;
if not FInherited then
if Assigned(OnKeyDown) then if not FInherited then
OnKeyDown(Self, Message.CharCode, Shift); if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end; end;
end. end.

124
components/mbColorLib/SLHColorPicker.pas
View File

@ -25,7 +25,8 @@ type
FSLPicker: TSLColorPicker; FSLPicker: TSLColorPicker;
FHPicker: THColorPicker; FHPicker: THColorPicker;
FSelectedColor: TColor; FSelectedColor: TColor;
FHValue, FSValue, FLValue: integer; FHValue, FSValue, FLValue: Double;
FMaxH, FMaxS, FMaxL: Integer;
FRValue, FGValue, FBValue: integer; FRValue, FGValue, FBValue: integer;
FSLHint, FHHint: string; FSLHint, FHHint: string;
FSLMenu, FHMenu: TPopupMenu; FSLMenu, FHMenu: TPopupMenu;
@ -33,12 +34,18 @@ type
PBack: TBitmap; PBack: TBitmap;
function GetManual: boolean; function GetManual: boolean;
procedure SelectColor(c: TColor); procedure SelectColor(c: TColor);
procedure SetH(v: integer); function GetH: Integer;
procedure SetS(v: integer); function GetS: Integer;
procedure SetL(v: integer); function GetL: Integer;
procedure SetR(v: integer); procedure SetH(H: integer);
procedure SetG(v: integer); procedure SetS(S: integer);
procedure SetB(v: integer); procedure SetL(L: integer);
procedure SetR(R: integer);
procedure SetG(G: integer);
procedure SetB(B: integer);
procedure SetMaxH(H: Integer);
procedure SetMaxS(S: Integer);
procedure SetMaxL(L: Integer);
procedure SetHHint(h: string); procedure SetHHint(h: string);
procedure SetSLHint(h: string); procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu); procedure SetSLMenu(m: TPopupMenu);
@ -63,12 +70,12 @@ type
function GetHexColorUnderCursor: string; override; function GetHexColorUnderCursor: string; override;
function GetSelectedHexColor: string; function GetSelectedHexColor: string;
property ColorUnderCursor; property ColorUnderCursor;
property HValue: integer read FHValue write SetH default 0; property Hue: integer read GetH write SetH;
property SValue: integer read FSValue write SetS default 240; property Saturation: integer read GetS write SetS;
property LValue: integer read FLValue write SetL default 120; property Luminance: integer read GetL write SetL;
property RValue: integer read FRValue write SetR default 255; property Red: integer read FRValue write SetR default 255;
property GValue: integer read FGValue write SetG default 0; property Green: integer read FGValue write SetG default 0;
property BValue: integer read FBValue write SetB default 0; property Blue: integer read FBValue write SetB default 0;
property Manual: boolean read GetManual; property Manual: boolean read GetManual;
published published
property SelectedColor: TColor read FSelectedColor write SelectColor default clRed; property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
@ -111,6 +118,9 @@ begin
inherited; inherited;
//ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque]; //ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
DoubleBuffered := true; DoubleBuffered := true;
FMaxH := 359;
FMaxS := 240;
FMaxL := 100;
PBack := TBitmap.Create; PBack := TBitmap.Create;
PBack.PixelFormat := pf32bit; PBack.PixelFormat := pf32bit;
ParentColor := true; ParentColor := true;
@ -142,9 +152,14 @@ begin
{$ELSE} {$ELSE}
SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA); SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA);
{$ENDIF} {$ENDIF}
MaxHue := self.FMaxH;
MaxSaturation := 255;
MaxValue := 255;
Saturation := MaxSaturation;
Value := MaxValue;
// Anchors := [akTop, akRight, akBottom]; // Anchors := [akTop, akRight, akBottom];
Visible := true; Visible := true;
Layout := lyVertical; // Layout := lyVertical;
ArrowPlacement := spBoth; ArrowPlacement := spBoth;
NewArrowStyle := true; NewArrowStyle := true;
OnChange := HPickerChange; OnChange := HPickerChange;
@ -167,12 +182,17 @@ begin
//Anchors := [akLeft, akRight, akTop, akBottom]; //Anchors := [akLeft, akRight, akTop, akBottom];
Visible := true; Visible := true;
SelectedColor := clRed; SelectedColor := clRed;
MaxHue := FMaxH;
MaxSaturation := FMaxS;
MaxLuminance := FMaxL;
Saturation := FMaxS;
Luminance := FMaxL;
OnChange := SLPickerChange; OnChange := SLPickerChange;
OnMouseMove := DoMouseMove; OnMouseMove := DoMouseMove;
end; end;
FHValue := 0; FHValue := 0;
FSValue := 255; FSValue := 1.0;
FLValue := 255; FLValue := 1.0;
FRValue := 255; FRValue := 255;
FGValue := 0; FGValue := 0;
FBValue := 0; FBValue := 0;
@ -202,9 +222,9 @@ end;
procedure TSLHColorPicker.DoChange; procedure TSLHColorPicker.DoChange;
begin begin
FHValue := FHPicker.Hue; FHValue := FHPicker.Hue / FHPicker.MaxHue;
FSValue := FSLPicker.Saturation; FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation;
FLValue := FSLPicker.Luminance; FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance;
FRValue := GetRValue(FSLPicker.SelectedColor); FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor); FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor); FBValue := GetBValue(FSLPicker.SelectedColor);
@ -219,43 +239,77 @@ begin
FSLPicker.SelectedColor := c; FSLPicker.SelectedColor := c;
end; end;
procedure TSLHColorPicker.SetH(v: integer); function TSLHColorPicker.GetH: Integer;
begin begin
FHValue := v; Result := Round(FHValue * FMaxH);
FSLPicker.Hue := v;
FHPicker.Hue := v;
end; end;
procedure TSLHColorPicker.SetS(v: integer); function TSLHColorPicker.GetS: Integer;
begin begin
FSValue := v; Result := Round(FSValue * FMaxS);
FSLPicker.Saturation := v;
end; end;
procedure TSLHColorPicker.SetL(v: integer); function TSLHColorPicker.GetL: Integer;
begin begin
FLValue := v; Result := ROund(FLValue * FMaxL);
FSLPicker.Luminance := v;
end; end;
procedure TSLHColorPicker.SetR(v: integer); procedure TSLHColorPicker.SetH(H: integer);
begin begin
FRValue := v; FHValue := H / FMaxH;
FSLPicker.Hue := H;
FHPicker.Hue := H;
end;
procedure TSLHColorPicker.SetS(S: integer);
begin
FSValue := S / FMaxS;
FSLPicker.Saturation := S;
end;
procedure TSLHColorPicker.SetL(L: integer);
begin
FLValue := L / FMaxL;
FSLPicker.Luminance := L;
end;
procedure TSLHColorPicker.SetR(R: integer);
begin
FRValue := R;
SelectColor(RGB(FRValue, FGValue, FBValue)); SelectColor(RGB(FRValue, FGValue, FBValue));
end; end;
procedure TSLHColorPicker.SetG(v: integer); procedure TSLHColorPicker.SetG(G: integer);
begin begin
FGValue := v; FGValue := G;
SelectColor(RGB(FRValue, FGValue, FBValue)); SelectColor(RGB(FRValue, FGValue, FBValue));
end; end;
procedure TSLHColorPicker.SetB(v: integer); procedure TSLHColorPicker.SetB(B: integer);
begin begin
FBValue := v; FBValue := B;
SelectColor(RGB(FRValue, FGValue, FBValue)); SelectColor(RGB(FRValue, FGValue, FBValue));
end; end;
procedure TSLHColorPicker.SetMaxH(H: Integer);
begin
FMaxH := H;
FSLPicker.MaxHue := H;
FHPicker.MaxHue := H;
end;
procedure TSLHColorPicker.SetMaxS(S: Integer);
begin
FMaxS := S;
FSLPicker.MaxSaturation := S;
end;
procedure TSLHColorPicker.SetMaxL(L: Integer);
begin
FMaxL := L;
FSLPicker.MaxLuminance := L;
end;
function TSLHColorPicker.GetSelectedHexColor: string; function TSLHColorPicker.GetSelectedHexColor: string;
begin begin
Result := ColorToHex(FSelectedColor); Result := ColorToHex(FSelectedColor);

2
components/mbColorLib/VColorPicker.pas
View File

@ -61,7 +61,7 @@ begin
FMaxSat := 255; FMaxSat := 255;
FMaxVal := 255; FMaxVal := 255;
FGradientWidth := FMaxVal + 1; FGradientWidth := FMaxVal + 1;
FGradientHeight := 12; FGradientHeight := 1;
FHue := 0; FHue := 0;
FSat := 0; FSat := 0;
FChange := false; FChange := false;

11
components/mbColorLib/YColorPicker.pas
View File

@ -54,7 +54,7 @@ constructor TYColorPicker.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FGradientWidth := 255; FGradientWidth := 255;
FGradientHeight := 12; FGradientHeight := 1;
FYellow := 255; FYellow := 255;
FMagenta := 0; FMagenta := 0;
FCyan := 0; FCyan := 0;
@ -70,7 +70,7 @@ end;
function TYColorPicker.GetGradientColor(AValue: Integer): TColor; function TYColorPicker.GetGradientColor(AValue: Integer): TColor;
begin begin
Result := CMYKtoTColor(FCyan, FMagenta, AValue, FBlack); Result := CMYKtoColor(FCyan, FMagenta, AValue, FBlack);
end; end;
procedure TYColorPicker.SetYellow(y: integer); procedure TYColorPicker.SetYellow(y: integer);
@ -158,10 +158,9 @@ end;
function TYColorPicker.GetSelectedColor: TColor; function TYColorPicker.GetSelectedColor: TColor;
begin begin
if not WebSafe then Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
Result := CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack) if WebSafe then
else Result := GetWebSafe(Result);
Result := GetWebSafe(CMYKtoTColor(FCyan, FMagenta, FYellow, FBlack));
end; end;
function TYColorPicker.GetSelectedValue: integer; function TYColorPicker.GetSelectedValue: integer;

10
components/mbColorLib/examples/fulldemo/Demo.lpi
View File

@ -9,7 +9,9 @@
<Title Value="Demo"/> <Title Value="Demo"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/> <XPManifest>
<DpiAware Value="True"/>
</XPManifest>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">
<Item1 Name="Default" Default="True"/> <Item1 Name="Default" Default="True"/>
@ -56,8 +58,14 @@
</SearchPaths> </SearchPaths>
<Linking> <Linking>
<Debugging> <Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/> <UseExternalDbgSyms Value="True"/>
</Debugging> </Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking> </Linking>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>

36
components/mbColorLib/examples/fulldemo/main.lfm
View File

@ -10,6 +10,7 @@ object Form1: TForm1
OnCreate = FormCreate OnCreate = FormCreate
ShowHint = True ShowHint = True
LCLVersion = '1.7' LCLVersion = '1.7'
Scaled = True
object Label1: TLabel object Label1: TLabel
Left = 416 Left = 416
Height = 15 Height = 15
@ -42,9 +43,9 @@ object Form1: TForm1
Height = 384 Height = 384
Top = 6 Top = 6
Width = 403 Width = 403
ActivePage = TabSheet3 ActivePage = TabSheet1
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
TabIndex = 2 TabIndex = 0
TabOrder = 0 TabOrder = 0
OnChange = PageControl1Change OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove OnMouseMove = PageControl1MouseMove
@ -57,7 +58,7 @@ object Form1: TForm1
Height = 340 Height = 340
Top = 8 Top = 8
Width = 381 Width = 381
SelectedColor = 1024 SelectedColor = 3289805
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex' HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex'
LPickerHintFormat = 'Luminance: %l' LPickerHintFormat = 'Luminance: %l'
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
@ -600,6 +601,9 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0 TabOrder = 0
OnMouseMove = HSVColorPicker1MouseMove OnMouseMove = HSVColorPicker1MouseMove
Hue = 0
Saturation = 0
Value = 255
OnChange = HSVColorPicker1Change OnChange = HSVColorPicker1Change
end end
object VColorPicker2: TVColorPicker object VColorPicker2: TVColorPicker
@ -613,6 +617,9 @@ object Form1: TForm1
Anchors = [akTop, akRight, akBottom] Anchors = [akTop, akRight, akBottom]
TabOrder = 1 TabOrder = 1
OnChange = VColorPicker2Change OnChange = VColorPicker2Change
Hue = 0
Saturation = 0
Value = 255
SelectedColor = clWhite SelectedColor = clWhite
end end
end end
@ -712,9 +719,10 @@ object Form1: TForm1
SelectionIndicator = siRect SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 2 TabOrder = 2
Saturation = 238 Hue = 0
Luminance = 60 Saturation = 51
SelectedColor = 263284 Luminance = 240
SelectedColor = clWhite
end end
object VColorPicker1: TVColorPicker object VColorPicker1: TVColorPicker
Left = 34 Left = 34
@ -727,7 +735,7 @@ object Form1: TForm1
SelectionIndicator = siRect SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 3 TabOrder = 3
Hue = 240 Hue = 239
Saturation = 255 Saturation = 255
Value = 40 Value = 40
SelectedColor = 2621440 SelectedColor = 2621440
@ -744,7 +752,9 @@ object Form1: TForm1
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
TabOrder = 4 TabOrder = 4
OnGetHintStr = HColorPicker1GetHintStr OnGetHintStr = HColorPicker1GetHintStr
Hue = 0
Saturation = 120 Saturation = 120
Value = 255
SelectedColor = 8882175 SelectedColor = 8882175
end end
object SColorPicker1: TSColorPicker object SColorPicker1: TSColorPicker
@ -761,6 +771,7 @@ object Form1: TForm1
TabOrder = 5 TabOrder = 5
Hue = 60 Hue = 60
Saturation = 80 Saturation = 80
Value = 255
SelectedColor = 11534335 SelectedColor = 11534335
end end
object Memo1: TMemo object Memo1: TMemo
@ -820,11 +831,11 @@ object Form1: TForm1
Height = 155 Height = 155
Top = 6 Top = 6
Width = 211 Width = 211
SelectedColor = 518633 SelectedColor = 15797774
HintFormat = 'H: %h S: %s'#13'Hex: %hex' HintFormat = 'H: %h S: %s'#13'Hex: %hex'
TabOrder = 0 TabOrder = 0
OnMouseMove = HSColorPicker1MouseMove OnMouseMove = HSColorPicker1MouseMove
HueValue = 60 Luminance = 120
MarkerStyle = msSquare MarkerStyle = msSquare
OnChange = HSColorPicker1Change OnChange = HSColorPicker1Change
end end
@ -833,9 +844,13 @@ object Form1: TForm1
Height = 147 Height = 147
Top = 144 Top = 144
Width = 161 Width = 161
SelectedColor = 2763306
HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex' HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex'
TabOrder = 1 TabOrder = 1
OnMouseMove = SLColorPicker1MouseMove OnMouseMove = SLColorPicker1MouseMove
Hue = 0
Saturation = 0
Luminance = 100
MarkerStyle = msCross MarkerStyle = msCross
OnChange = SLColorPicker1Change OnChange = SLColorPicker1Change
end end
@ -847,6 +862,9 @@ object Form1: TForm1
HintFormat = 'Hue: %h (selected)' HintFormat = 'Hue: %h (selected)'
TabOrder = 2 TabOrder = 2
OnMouseMove = HRingPicker1MouseMove OnMouseMove = HRingPicker1MouseMove
Hue = 0
Saturation = 255
Value = 255
OnChange = HRingPicker1Change OnChange = HRingPicker1Change
end end
end end

4
components/mbColorLib/examples/trackbars/Demo.lpi
View File

@ -9,10 +9,6 @@
<Title Value="Demo"/> <Title Value="Demo"/>
<ResourceType Value="res"/> <ResourceType Value="res"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<XPManifest>
<TextName Value="CompanyName.ProductName.AppName"/>
<TextDesc Value="Your application description."/>
</XPManifest>
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<BuildModes Count="1"> <BuildModes Count="1">

32
components/mbColorLib/examples/trackbars/main.lfm
View File

@ -184,6 +184,9 @@ object Form1: TForm1
Visible = False Visible = False
TabOrder = 5 TabOrder = 5
OnChange = SLVPickerV_Change OnChange = SLVPickerV_Change
Hue = 0
Saturation = 0
Value = 255
SelectedColor = clWhite SelectedColor = clWhite
end end
object LColorPickerV: TLColorPicker object LColorPickerV: TLColorPicker
@ -196,9 +199,10 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
TabOrder = 6 TabOrder = 6
OnChange = SLVPickerV_Change OnChange = SLVPickerV_Change
Saturation = 255 Hue = 0
Luminance = 127 Saturation = 240
SelectedColor = 254 Luminance = 239
SelectedColor = 16645631
end end
object HColorPickerV: THColorPicker object HColorPickerV: THColorPicker
Left = 288 Left = 288
@ -210,6 +214,9 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
TabOrder = 7 TabOrder = 7
OnChange = HPickerV_Change OnChange = HPickerV_Change
Hue = 0
Saturation = 255
Value = 255
end end
object KColorPickerV: TKColorPicker object KColorPickerV: TKColorPicker
Left = 232 Left = 232
@ -305,6 +312,9 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
TabOrder = 15 TabOrder = 15
OnChange = SLVPickerV_Change OnChange = SLVPickerV_Change
Hue = 0
Saturation = 255
Value = 255
end end
end end
end end
@ -471,6 +481,9 @@ object Form1: TForm1
Visible = False Visible = False
TabOrder = 5 TabOrder = 5
OnChange = SLVPickerH_Change OnChange = SLVPickerH_Change
Hue = 0
Saturation = 0
Value = 255
SelectedColor = clWhite SelectedColor = clWhite
end end
object LColorPickerH: TLColorPicker object LColorPickerH: TLColorPicker
@ -483,9 +496,10 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
TabOrder = 6 TabOrder = 6
OnChange = SLVPickerH_Change OnChange = SLVPickerH_Change
Saturation = 255 Hue = 0
Luminance = 127 Saturation = 240
SelectedColor = 254 Luminance = 239
SelectedColor = 16645631
end end
object SColorPickerH: TSColorPicker object SColorPickerH: TSColorPicker
Left = 24 Left = 24
@ -497,6 +511,9 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
TabOrder = 7 TabOrder = 7
OnChange = SLVPickerH_Change OnChange = SLVPickerH_Change
Hue = 0
Saturation = 255
Value = 255
end end
object HColorPickerH: THColorPicker object HColorPickerH: THColorPicker
Left = 24 Left = 24
@ -508,6 +525,9 @@ object Form1: TForm1
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
TabOrder = 8 TabOrder = 8
OnChange = HPickerH_Change OnChange = HPickerH_Change
Hue = 0
Saturation = 255
Value = 255
end end
object KColorPickerH: TKColorPicker object KColorPickerH: TKColorPicker
Left = 24 Left = 24

16
components/mbColorLib/examples/trackbars/main.pas
View File

@ -112,7 +112,7 @@ begin
if (CColorPickerH = nil) or (YColorPickerH = nil) or (MColorPickerH = nil) or if (CColorPickerH = nil) or (YColorPickerH = nil) or (MColorPickerH = nil) or
(KColorPickerH = nil) or (CMYKh = nil) then (KColorPickerH = nil) or (CMYKh = nil) then
exit; exit;
CMYKh.Color := CMYKToTColor( CMYKh.Color := CMYKToColor(
CColorPickerH.Cyan, CColorPickerH.Cyan,
MColorPickerH.Magenta, MColorPickerH.Magenta,
YColorPickerH.Yellow, YColorPickerH.Yellow,
@ -136,7 +136,7 @@ begin
if (CColorPickerV = nil) or (YColorPickerV = nil) or (MColorPickerV = nil) or if (CColorPickerV = nil) or (YColorPickerV = nil) or (MColorPickerV = nil) or
(KColorPickerV = nil) or (CMYKv = nil) then (KColorPickerV = nil) or (CMYKv = nil) then
exit; exit;
CMYKv.Color := CMYKToTColor( CMYKv.Color := CMYKToColor(
CColorPickerV.Cyan, CColorPickerV.Cyan,
MColorPickerV.Magenta, MColorPickerV.Magenta,
YColorPickerV.Yellow, YColorPickerV.Yellow,
@ -156,6 +156,10 @@ end;
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
MaxHue := 359;
MaxSat := 240;
MaxLum := 240;
VColorPickerH.Left := LColorPickerH.Left; VColorPickerH.Left := LColorPickerH.Left;
VColorPickerH.Top := LColorPickerH.Top; VColorPickerH.Top := LColorPickerH.Top;
VColorPickerH.Width := LColorPickerH.Width; VColorPickerH.Width := LColorPickerH.Width;
@ -279,14 +283,12 @@ begin
if rbHSLh.Checked then begin if rbHSLh.Checked then begin
if (LColorPickerH = nil) then if (LColorPickerH = nil) then
exit; exit;
triple := HSLToRGBTriple(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance); HSLVh.Color := HSLRangeToRGB(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance);
HSLVh.Color := RGBTripleToTColor(triple);
// HSLVh.Color := HSLRangetoRGB(HColorPickerH.Hue, SColorPickerH.Saturation, LColorPickerH.Luminance);
end; end;
if rbHSVh.Checked then begin if rbHSVh.Checked then begin
if (VColorPickerH = nil) then if (VColorPickerH = nil) then
exit; exit;
HSLVh.Color := HSVtoColor(HColorPickerH.Hue, SColorPickerH.Saturation, VColorPickerH.Value); HSLVh.Color := HSVRangetoColor(HColorPickerH.Hue, SColorPickerH.Saturation, VColorPickerH.Value);
end; end;
c := HSLVh.Color; c := HSLVh.Color;
@ -310,7 +312,7 @@ begin
if (LColorPickerV = nil) then if (LColorPickerV = nil) then
exit; exit;
triple := HSLToRGBTriple(HColorPickerV.Hue, SColorPickerV.Saturation, LColorPickerV.Luminance); triple := HSLToRGBTriple(HColorPickerV.Hue, SColorPickerV.Saturation, LColorPickerV.Luminance);
HSLVv.Color := RGBTripleToTColor(triple); HSLVv.Color := RGBTripleToColor(triple);
end; end;
if rbHSVv.Checked then begin if rbHSVv.Checked then begin
if (VColorPickerV = nil) then if (VColorPickerV = nil) then

6
components/mbColorLib/mbBasicPicker.pas
View File

@ -93,13 +93,14 @@ end;
destructor TmbBasicPicker.Destroy; destructor TmbBasicPicker.Destroy;
begin begin
//HideHintWindow; FBufferBmp.Free;
inherited; inherited;
end; end;
procedure TmbBasicPicker.CMHintShow(var Message: TCMHintShow); procedure TmbBasicPicker.CMHintShow(var Message: TCMHintShow);
var var
cp: TPoint; cp: TPoint;
hp: TPoint;
begin begin
if GetColorUnderCursor <> clNone then if GetColorUnderCursor <> clNone then
with TCMHintShow(Message) do with TCMHintShow(Message) do
@ -111,10 +112,11 @@ begin
else else
begin begin
cp := HintInfo^.CursorPos; cp := HintInfo^.CursorPos;
hp := GetHintPos(cp.X, cp.Y);
HintInfo^.ReshowTimeout := 0; // must be zero! HintInfo^.ReshowTimeout := 0; // must be zero!
HintInfo^.HideTimeout := Application.HintHidePause; HintInfo^.HideTimeout := Application.HintHidePause;
HintInfo^.HintStr := GetHintStr(cp.X, cp.Y); HintInfo^.HintStr := GetHintStr(cp.X, cp.Y);
HintInfo^.HintPos := ClientToScreen(GetHintPos(cp.X, cp.Y)); HintInfo^.HintPos := ClientToScreen(Point(hp.X + 16, hp.Y));
HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1); HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1);
Result := 0; // 0 means: show hint Result := 0; // 0 means: show hint
end; end;

1
components/mbColorLib/mbDeskPickerButton.pas
View File

@ -33,7 +33,6 @@ type
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure Click; override; procedure Click; override;
property SelectedColor: TColor read FSelColor; property SelectedColor: TColor read FSelColor;
published published
property OnSelColorChange: TNotifyEvent read FOnColorPicked write FOnColorPicked; property OnSelColorChange: TNotifyEvent read FOnColorPicked write FOnColorPicked;

1
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -239,7 +239,6 @@ end;
destructor TmbTrackbarPicker.Destroy; destructor TmbTrackbarPicker.Destroy;
begin begin
FBufferBmp.Free;
FBack.Free; FBack.Free;
inherited; inherited;
end; end;