diff --git a/components/mbColorLib/BColorPicker.pas b/components/mbColorLib/BColorPicker.pas
index b2cf5d2d3..9fc45588f 100644
--- a/components/mbColorLib/BColorPicker.pas
+++ b/components/mbColorLib/BColorPicker.pas
@@ -20,24 +20,25 @@ type
FRed, FGreen, FBlue: integer;
function ArrowPosFromBlue(b: integer): integer;
function BlueFromArrowPos(p: integer): integer;
- function GetSelectedColor: TColor;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
- procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Blue: integer read FBlue write SetBlue default 255;
property Green: integer read FGreen write SetGreen default 128;
property Red: integer read FRed write SetRed default 128;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
diff --git a/components/mbColorLib/CColorPicker.pas b/components/mbColorLib/CColorPicker.pas
index 60a8d0d84..240ee6df1 100644
--- a/components/mbColorLib/CColorPicker.pas
+++ b/components/mbColorLib/CColorPicker.pas
@@ -17,17 +17,17 @@ type
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromCyan(c: integer): integer;
function CyanFromArrowPos(p: integer): integer;
- function GetSelectedColor: TColor;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
- procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -35,8 +35,9 @@ type
property Cyan: integer read FCyan write SetCyan default 255;
property Magenta: integer read FMagenta write SetMagenta default 0;
property Yellow: integer read FYellow write SetYellow default 0;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
diff --git a/components/mbColorLib/CIEAColorPicker.pas b/components/mbColorLib/CIEAColorPicker.pas
index 6018cfeca..d80aa0c86 100644
--- a/components/mbColorLib/CIEAColorPicker.pas
+++ b/components/mbColorLib/CIEAColorPicker.pas
@@ -7,8 +7,7 @@ unit CIEAColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Forms,
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
diff --git a/components/mbColorLib/CIEBColorPicker.pas b/components/mbColorLib/CIEBColorPicker.pas
index d5a97af21..24b0db4c9 100644
--- a/components/mbColorLib/CIEBColorPicker.pas
+++ b/components/mbColorLib/CIEBColorPicker.pas
@@ -7,8 +7,7 @@ unit CIEBColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Forms,
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
diff --git a/components/mbColorLib/CIELColorPicker.pas b/components/mbColorLib/CIELColorPicker.pas
index fdfbf0c97..e2f103ed5 100644
--- a/components/mbColorLib/CIELColorPicker.pas
+++ b/components/mbColorLib/CIELColorPicker.pas
@@ -7,8 +7,7 @@ unit CIELColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Math, Forms,
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
@@ -171,7 +170,6 @@ end;
procedure TCIELColorPicker.Resize;
begin
- FManual := false;
mx := Round((FA + 128) * Width / 255);
my := Round((255 - (FB + 128)) * Height / 255);
inherited;
diff --git a/components/mbColorLib/GAxisColorPicker.pas b/components/mbColorLib/GAxisColorPicker.pas
index 153f71071..f0c9df649 100644
--- a/components/mbColorLib/GAxisColorPicker.pas
+++ b/components/mbColorLib/GAxisColorPicker.pas
@@ -61,7 +61,6 @@ begin
FB := 0;
FR := 0;
FSelected := clLime;
- FManual := false;
MarkerStyle := msCircle;
end;
@@ -159,7 +158,6 @@ end;
procedure TGAxisColorPicker.Resize;
begin
- FManual := false;
mx := Round(FB * Width / 255);
my := Round((255 - FR) * Height / 255);
inherited;
diff --git a/components/mbColorLib/GColorPicker.pas b/components/mbColorLib/GColorPicker.pas
index 94d366c29..452e1eb2f 100644
--- a/components/mbColorLib/GColorPicker.pas
+++ b/components/mbColorLib/GColorPicker.pas
@@ -7,7 +7,7 @@ unit GColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, mbTrackBarPicker;
type
@@ -15,25 +15,26 @@ type
private
FRed, FGreen, FBlue: integer;
function ArrowPosFromGreen(g: integer): integer;
- function GetSelectedColor: TColor;
function GreenFromArrowPos(p: integer): integer;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
- procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Red: integer read FRed write SetRed default 128;
property Green: integer read FGreen write SetGreen default 255;
property Blue: integer read FBlue write SetBlue default 128;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
diff --git a/components/mbColorLib/HColorPicker.pas b/components/mbColorLib/HColorPicker.pas
index aede1432a..1e53fcc4b 100644
--- a/components/mbColorLib/HColorPicker.pas
+++ b/components/mbColorLib/HColorPicker.pas
@@ -7,27 +7,14 @@ unit HColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
- RGBHSVUtils, HTMLColors, mbTrackBarPicker;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
+ HTMLColors, mbColorConv, mbTrackBarPicker;
type
- THColorPicker = class(TmbTrackBarPicker)
+ THColorPicker = class(TmbHSLVTrackBarPicker)
private
- FHue, FSat, FVal: Double;
- FMaxHue, FMaxSat, FMaxVal: Integer;
- function ArrowPosFromHue(h: integer): integer;
- function HueFromArrowPos(p: integer): integer;
- function GetHue: Integer;
- function GetSat: Integer;
- function GetSelectedColor: TColor;
- function GetVal: Integer;
- procedure SetHue(h: integer);
- procedure SetMaxHue(h: Integer);
- procedure SetMaxSat(s: Integer);
- procedure SetMaxVal(v: Integer);
- procedure SetSat(s: integer);
- procedure SetSelectedColor(c: TColor);
- procedure SetVal(v: integer);
+ function ArrowPosFromHue(h: Double): integer;
+ function HueFromArrowPos(p: integer): Double;
protected
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
@@ -35,17 +22,19 @@ type
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetMaxHue(H: Integer); override;
+ procedure SetRelHue(H: Double); override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
- property Hue: integer read GetHue write SetHue;
- property Saturation: integer read GetSat write SetSat;
- property Value: integer read GetVal write SetVal;
property Layout default lyHorizontal;
- property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
- property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
- property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property Hue default 0;
+ property Saturation default 255;
+ property Luminance default 127;
+ property Value default 255;
+ property SelectedColor default clRed;
+ property HintFormat;
end;
@@ -59,29 +48,27 @@ uses
constructor THColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FMaxHue := 359;
- FMaxSat := 255;
- FMaxVal := 255;
FGradientWidth := FMaxHue;
FGradientHeight := 1;
FSat := 1.0;
FVal := 1.0;
- SetHue(0);
+ FLum := 0.5;
+ Hue := 0;
HintFormat := 'Hue: %value (selected)';
end;
-function THColorPicker.ArrowPosFromHue(h: integer): integer;
+function THColorPicker.ArrowPosFromHue(H: Double): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
- a := Round((Width - 12) * h / FMaxHue);
+ a := Round((Width - 12) * H);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
- a := Round((Height - 12) * h / FMaxHue);
+ a := Round((Height - 12) * H);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@@ -92,40 +79,44 @@ function THColorPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
if Layout = lyVertical then WheelDelta := -WheelDelta;
- inherited;
+ WheelDelta := WheelDelta * 3; // use larger steps
+ Result := inherited;
end;
procedure THColorPicker.Execute(tbaAction: integer);
+var
+ dHue: Double;
begin
+ if FMaxHue = 0 then dHue := 0 else dHue := Increment / FMaxHue;
case tbaAction of
TBA_Resize:
- SetHue(GetHue);
+ SetRelHue(FHue); // wp: Is this working?
TBA_MouseMove:
- SetHue(HueFromArrowPos(FArrowPos));
+ SetRelHue(HueFromArrowPos(FArrowPos));
TBA_MouseDown:
- SetHue(HueFromArrowPos(FArrowPos));
+ SetRelHue(HueFromArrowPos(FArrowPos));
TBA_MouseUp:
- SetHue(HueFromArrowPos(FArrowPos));
+ SetRelHue(HueFromArrowPos(FArrowPos));
TBA_WheelUp:
- SetHue(GetHue() + Increment);
+ SetRelHue(FHue + dHue);
TBA_WheelDown:
- SetHue(GetHue() - Increment);
+ SetRelHue(FHue - dHue);
TBA_VKLeft:
- SetHue(GetHue() - Increment);
+ SetRelHue(FHue - dHue);
TBA_VKCtrlLeft:
- SetHue(0);
+ SetRelHue(0);
TBA_VKRight:
- SetHue(GetHue() + Increment);
+ SetRelHue(FHue + dHue);
TBA_VKCtrlRight:
- SetHue(FMaxHue);
+ SetRelHue(1 - dHue); // go one step below 360, or the hue will flip back to 0
TBA_VKUp:
- SetHue(GetHue() - Increment);
+ SetRelHue(FHue - dHue);
TBA_VKCtrlUp:
- SetHue(0);
+ SetRelHue(0);
TBA_VKDown:
- SetHue(GetHue() + Increment);
+ SetRelHue(FHue + dHue);
TBA_VKCtrlDown:
- SetHue(FMaxHue);
+ SetRelHue(1 - dHue);
else
inherited;
end;
@@ -136,109 +127,55 @@ begin
if FMaxHue = 0 then
Result := inherited GetArrowPos
else
- Result := ArrowPosFromHue(GetHue());
+ Result := ArrowPosFromHue(FHue);
end;
function THColorPicker.GetGradientColor(AValue: Integer): TColor;
var
h: Double;
begin
- if Layout = lyVertical then AValue := (FMaxHue + 1) - AValue;
+ if Layout = lyVertical then AValue := FMaxHue - 1 - AValue;
+ // Width is FMaxHue --> last index is FMaxHue - 1
h := AValue / FMaxHue;
- Result := HSVtoColor(h, FSat, FVal);
-end;
-
-function THColorPicker.GetHue: Integer;
-begin
- Result := round(FHue * FMaxHue);
-end;
-
-function THColorPicker.GetSat: Integer;
-begin
- Result := round(FSat * FMaxSat);
-end;
-
-function THColorPicker.GetSelectedColor: TColor;
-begin
- Result := HSVtoColor(FHue, FSat, FVal);
- if WebSafe then
- Result := GetWebSafe(Result);
+ Result := HSLVtoColor(h, FSat, FLum, FVal);
end;
function THColorPicker.GetSelectedValue: integer;
begin
- Result := GetHue();
+ Result := Hue;
end;
-function THColorPicker.GetVal: Integer;
-begin
- Result := round(FVal * FMaxVal);
-end;
-
-function THColorPicker.HueFromArrowPos(p: integer): integer;
+function THColorPicker.HueFromArrowPos(p: integer): Double;
var
- h: integer;
+ h: Double;
begin
case Layout of
- lyHorizontal:
- h := Round(p / (Width - 12) * FMaxHue);
- lyVertical:
- h := Round(p / (Height - 12) * MaxHue);
+ lyHorizontal : h := p / (Width - 12);
+ lyVertical : h := p / (Height - 12)
end;
- Clamp(h, 0, FMaxHue);
+ Clamp(h, 0, 1.0 - 1/FMaxHue);
Result := h;
end;
-procedure THColorPicker.SetHue(h: integer);
-begin
- Clamp(h, 0, FMaxHue);
- if GetHue <> h then
- begin
- FHue := h / FMaxHue;
- FArrowPos := ArrowPosFromHue(h);
- Invalidate;
- DoChange;
- end;
-end;
-
procedure THColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
- FGradientWidth := FMaxHue + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels
+ FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1
CreateGradient;
Invalidate;
- //if FChange and Assigned(OnChange) then OnChange(Self);
end;
-procedure THColorPicker.SetMaxSat(s: Integer);
+procedure THColorPicker.SetRelHue(H: Double);
begin
- if s = FMaxSat then
+ if FMaxHue = 0 then
exit;
- FMaxSat := s;
- CreateGradient;
- Invalidate;
- //if FChange and Assigned(OnChange) then OnChange(Self);
-end;
-
-procedure THColorPicker.SetMaxVal(v: Integer);
-begin
- if v = FMaxVal then
- exit;
- FMaxVal := v;
- CreateGradient;
- Invalidate;
-// if FChange and Assigned(OnChange) then OnChange(Self);
-end;
-
-procedure THColorPicker.SetSat(s: integer);
-begin
- Clamp(s, 0, FMaxSat);
- if GetSat() <> s then
+ Clamp(H, 0, 1 - 1/FMaxHue); // don't go up to 360 because this will flip back to the start
+ if (FHue <> H) then
begin
- FSat := s / FMaxSat;
- CreateGradient;
+ FHue := H;
+ FArrowPos := ArrowPosFromHue(H);
Invalidate;
DoChange;
end;
@@ -246,7 +183,10 @@ end;
procedure THColorPicker.SetSelectedColor(c: TColor);
var
- h, s, v: integer;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@@ -254,27 +194,25 @@ begin
if c = GetSelectedColor then
exit;
- RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
- needNewGradient := (s <> FSat) or (v <> FVal);
- FHue := h;
- FSat := s;
- FVal := v;
+ ColorToHSLV(c, H, S, L, V);
+ case BrightnessMode of
+ bmLuminance:
+ begin
+ needNewGradient := (S <> FSat) or (L <> FLum);
+ FLum := L;
+ end;
+ bmValue:
+ begin
+ needNewGradient := (S <> FSat) or (V <> FVal);
+ FVal := V;
+ end;
+ end;
+ FHue := H;
+ FSat := S;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
-procedure THColorPicker.SetVal(v: integer);
-begin
- Clamp(v, 0, FMaxVal);
- if GetVal() <> v then
- begin
- FVal := v / FMaxVal;
- CreateGradient;
- Invalidate;
- DoChange;
- end;
-end;
-
end.
diff --git a/components/mbColorLib/HRingPicker.pas b/components/mbColorLib/HRingPicker.pas
index 98e5d4980..ea18048b9 100644
--- a/components/mbColorLib/HRingPicker.pas
+++ b/components/mbColorLib/HRingPicker.pas
@@ -8,60 +8,44 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
- RGBHSVUtils, HTMLColors, mbColorPickerControl;
+ HTMLColors, mbColorConv, mbColorPickerControl;
type
- THRingPicker = class(TmbColorPickerControl)
+ THRingPicker = class(TmbHSLVColorPickerControl)
private
- FHue, FSat, FVal: Double;
- FMaxHue, FMaxSat, FMaxVal: Integer;
- FHueLineColor: TColor;
FSelectedColor: TColor;
- mx, my, mdx, mdy: integer;
- //FChange: boolean;
+ FHueLineColor: TColor;
FRadius: integer;
- FDragging: Boolean;
- function GetHue: Integer;
- function GetSat: Integer;
- function GetValue: Integer;
- function RadHue(New: integer): integer;
- procedure SetMaxHue(h: Integer);
- procedure SetMaxSat(s: Integer);
- procedure SetMaxValue(v: Integer);
procedure SetRadius(r: integer);
- procedure SetHue(h: integer);
- procedure SetSat(s: integer);
- procedure SetValue(v: integer);
procedure SetHueLineColor(c: TColor);
- procedure SelectionChanged(x, y: integer);
- procedure UpdateCoords;
protected
procedure CreateGradient; override;
procedure DrawHueLine;
function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: TColor; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- function MouseOnPicker(X, Y: Integer): Boolean;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+// function MouseOnPicker(X, Y: Integer): Boolean;
procedure Paint; override;
procedure Resize; override;
+ procedure SelectColor(x, y: integer); override;
+ procedure SetRelHue(H: Double); override;
procedure SetSelectedColor(c: TColor); override;
+ procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor;
published
- property Hue: integer read GetHue write SetHue;
- property Saturation: integer read GetSat write SetSat;
- property Value: integer read GetValue write SetValue;
- property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
- property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
- property MaxValue: Integer read FMaxVal write SetMaxValue default 255;
+ property Hue default 0;
+ property Luminance default 127;
+ property Saturation default 255;
+ property Value default 255;
+ property MaxHue default 360;
+ property MaxLuminance default 255;
+ property MaxSaturation default 255;
+ property MaxValue default 255;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property Radius: integer read FRadius write SetRadius default 40;
- property SelectedColor default clNone;
+ property SelectedColor default clRed; //clNone;
property OnChange;
end;
@@ -77,17 +61,13 @@ constructor THRingPicker.Create(AOwner: TComponent);
begin
inherited;
SetInitialBounds(0, 0, 204, 204);
- FMaxHue := 359;
- FMaxSat := 255;
- FMaxVal := 255;
+ FHue := 0.0;
FVal := 1.0;
-// FHue := 0.0;
+ FLum := 0.5;
FSat := 1.0;
- FHueLineColor := clGray;
SetSelectedColor(clRed);
-// FSelectedColor := clRed; clNone;
- FManual := false;
FRadius := 40;
+ FHueLineColor := clGray;
HintFormat := 'Hue: %h (selected)';
TabStop := true;
end;
@@ -108,7 +88,7 @@ begin
radius := Min(Width, Height) div 2;
if (FHue >= 0) and (FHue <= 1.0) then
begin
- angle := -FHue * 2 * pi;
+ angle := -FHue * TWO_PI;
SinCos(angle, sinAngle, cosAngle);
Canvas.Pen.Color := FHueLineColor;
Canvas.MoveTo(radius, radius);
@@ -134,9 +114,7 @@ begin
else if angle > 360 then
angle := angle - 360;
h := angle / 360;
- Result := HSVtoColor(h, FSat, FVal);
- if WebSafe then
- Result := GetWebSafe(Result);
+ Result := HSLVtoColor(h, FSat, FLum, FVal);
end
else
Result := clNone;
@@ -149,7 +127,6 @@ var
dSq, rSq: Integer;
radius, size: Integer;
H: Double;
- q: TRGBQuad;
begin
size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
@@ -162,79 +139,21 @@ begin
H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90;
if H > 360 then H := H - 360;
- Result := HSVtoColor(H/360, FSat, FVal);
+ Result := HSLVtoColor(H/360, FSat, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
Result := GetDefaultColor(dctBrush);
end;
-function THRingPicker.GetHue: Integer;
-begin
- Result := round(FHue * FMaxHue);
-end;
-
-function THRingPicker.GetSat: Integer;
-begin
- Result := round(FSat * FMaxSat);
-end;
-
function THRingPicker.GetSelectedColor: TColor;
begin
if FSelectedColor <> clNone then
- begin
- Result := HSVtoColor(FHue, FSat, FVal);
- if WebSafe then
- Result := GetWebSafe(Result);
- end
+ Result := HSLVtoColor(FHue, FSat, FLum, FVal)
else
Result := clNone;
end;
-
-function THRingPicker.GetValue: Integer;
-begin
- Result := round(FVal * FMaxVal);
-end;
-
-procedure THRingPicker.KeyDown(var Key: Word; Shift: TShiftState);
-var
- eraseKey: Boolean;
- delta: Integer;
-begin
- eraseKey := true;
- if ssCtrl in Shift then
- delta := 10
- else
- delta := 1;
-
- case Key of
- VK_LEFT : SetHue(RadHue(GetHue() + delta));
- VK_RIGHT : SetHue(RadHue(GetHue() - delta));
- else erasekey := false;
- end;
-
- if eraseKey then
- Key := 0;
-
- inherited;
-end;
-
-procedure THRingPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- Exit;
- if (Button = mbLeft) and MouseOnPicker(X, Y)
- then begin
- mdx := x;
- mdy := y;
- SelectionChanged(X, Y);
- FDragging := true;
- end;
- SetFocus;
-end;
-
+ {
function THRingPicker.MouseOnPicker(X, Y: Integer): Boolean;
var
diameter, r: Integer;
@@ -245,33 +164,7 @@ begin
P := Point(x, y);
ctr := Point(r, r);
Result := PtInCircle(P, ctr, r) and not PtInCircle(P, ctr, Radius);
-end;
-
-procedure THRingPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (ssLeft in Shift) and FDragging then
- begin
- mdx := x;
- mdy := y;
- SelectionChanged(X, Y);
- end;
-end;
-
-procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then Exit;
- if (Button = mbLeft) and FDragging then
- begin
- mdx := x;
- mdy := y;
- SelectionChanged(X, Y);
- FDragging := false;
- end;
-end;
+end; }
procedure THRingPicker.Paint;
var
@@ -302,45 +195,26 @@ begin
DoChange;
end;
-function THRingPicker.RadHue(New: integer): integer;
-begin
- if New < 0 then New := New + (FMaxHue + 1);
- if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
- Result := New;
-end;
-
procedure THRingPicker.Resize;
begin
inherited;
- CreateGradient;
+ if Min(Width, Height) <> FGradientWidth then
+ CreateGradient;
UpdateCoords;
end;
-procedure THRingPicker.SelectionChanged(x, y: integer);
+procedure THRingPicker.SelectColor(x, y: integer);
var
angle, dx, dy, Radius: integer;
begin
+ mx := y;
+ my := y;
FSelectedColor := clWhite;
radius := Min(Width, Height) div 2;
dx := x - radius;
dy := y - radius;
angle := round(360 + 180*arctan2(-dy, dx) / pi);
- if angle < 0 then
- inc(angle, 360)
- else if angle > 360 then
- dec(angle, 360);
- SetHue(MulDiv(angle, FMaxHue + 1, 360));
-end;
-
-procedure THRingPicker.SetHue(h: integer);
-begin
- h := RadHue(h);
- if GetHue() <> h then
- begin
- FHue := h / FMaxHue;
- Invalidate;
- DoChange;
- end;
+ SetRelHue(angle/360);
end;
procedure THRingPicker.SetHueLineColor(c: TColor);
@@ -352,36 +226,6 @@ begin
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 = FMaxVal then
- exit;
- FMaxVal := v;
- CreateGradient;
- Invalidate;
-// if FChange and Assigned(OnChange) then OnChange(Self);
-end;
-
procedure THRingPicker.SetRadius(r: integer);
begin
if FRadius <> r then
@@ -391,20 +235,38 @@ begin
end;
end;
-procedure THRingPicker.SetSat(s: integer);
+procedure THRingPicker.SetRelHue(H: Double);
begin
- Clamp(s, 0, FMaxSat);
- if GetSat() <> s then
+ if H > 1 then H := H - 1;
+ if H < 0 then H := H + 1;
+ if FHue <> h then
begin
- FSat := s / FMaxSat;
+ FHue := h;
+ UpdateCoords;
Invalidate;
DoChange;
end;
end;
+(*
+procedure THRingPicker.SetSat(s: integer);
+begin
+ Clamp(s, 0, FMaxSat);
+ if Saturation <> s then
+ begin
+ FSat := s / FMaxSat;
+ UpdateCoords;
+ Invalidate;
+ DoChange;
+ end;
+end;
+*)
procedure THRingPicker.SetSelectedColor(c: TColor);
var
- h, s, v: Double;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@@ -412,11 +274,21 @@ begin
if c = GetSelectedColor then
Exit;
- RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
- needNewGradient := (s <> FSat) or (v <> FVal);
+ ColorToHSLV(c, H, S, L, V);
+ case BrightnessMode of
+ bmLuminance:
+ begin
+ needNewGradient := (S <> FSat) or (L <> FLum);
+ FLum := L;
+ end;
+ bmValue:
+ begin
+ needNewGradient := (S <> FSat) or (V <> FVal);
+ FVal := V;
+ end;
+ end;
FHue := h;
FSat := s;
- FVal := v;
UpdateCoords;
if needNewGradient then
CreateGradient;
@@ -424,18 +296,22 @@ begin
DoChange;
end;
-procedure THRingPicker.SetValue(v: integer);
+(*
+procedure THRingPicker.SetVal(v: integer);
begin
Clamp(v, 0, FMaxVal);
- if GetValue() <> V then
+ if Value <> V then
begin
FVal := V / FMaxVal;
- CreateGradient;
- Invalidate;
+ if BrightnessMode = bmValue then
+ begin
+ CreateGradient;
+ Invalidate;
+ end;
DoChange;
end;
end;
-
+*)
procedure THRingPicker.UpdateCoords;
var
r, angle: double;
@@ -446,8 +322,8 @@ begin
r := -radius * FSat;
angle := -(FHue * 2 + 1) * pi;
SinCos(angle, sinAngle, cosAngle);
- mdx := round(cosAngle * r) + radius;
- mdy := round(sinAngle * r) + radius;
+ mx := round(cosAngle * r) + radius;
+ my := round(sinAngle * r) + radius;
end;
end.
diff --git a/components/mbColorLib/HSColorPicker.pas b/components/mbColorLib/HSColorPicker.pas
index 5d11acbe4..6e145b569 100644
--- a/components/mbColorLib/HSColorPicker.pas
+++ b/components/mbColorLib/HSColorPicker.pas
@@ -4,94 +4,77 @@ unit HSColorPicker;
{$MODE DELPHI}
{$ENDIF}
-{$DEFINE USE COLOR_TO_RGB}
-
interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
- RGBHSLUtils, HTMLColors, mbColorPickerControl;
+ HTMLColors, mbColorConv, mbColorPickerControl;
type
{ THSColorPicker }
- THSColorPicker = class(TmbColorPickerControl)
+ THSColorPicker = class(TmbHSLVColorPickerControl)
private
- FHue, FSat, FLum, FLumSel: Double;
- FMaxHue, FMaxSat, FMaxLum: Integer;
- function GetHue: 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);
+ FLumDisp, FValDisp: Double; // Lum and Value used for display
protected
- procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ function GetSelectedColor: TColor; override;
procedure Paint; override;
function PredictColor: TColor;
procedure Resize; override;
- procedure SelectColor(x, y: Integer);
+ procedure SelectColor(x, y: Integer); override;
+ procedure SetMaxHue(H: Integer); override;
+ procedure SetMaxSat(S: Integer); override;
+ procedure SetRelHue(H: Double); override;
+ procedure SetRelSat(S: Double); override;
procedure SetSelectedColor(c: TColor); override;
procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
- function GetSelectedColor: TColor; override;
published
property SelectedColor default clRed;
- property Hue: integer read GetHue write SetHue default 0;
- property Saturation: integer read GetSat write SetSat default 240;
- property Luminance: Integer read GetLum write SetLum default 120;
- 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 Hue default 0;
+ property Saturation default 255;
+ property Luminance default 127;
+ property Value default 255;
+ property MaxHue default 360;
+ property MaxSaturation default 255;
+ property MaxLuminance default 255;
+ property MaxValue default 255;
property MarkerStyle default msCross;
property OnChange;
end;
+
implementation
uses
- math, mbUtils;
+ Math, mbUtils;
-{THSColorPicker}
+{ THSColorPicker }
constructor THSColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FMaxHue := 359;
- FMaxSat := 240;
- FMaxLum := 240;
- FGradientWidth := FMaxHue + 1;
+ FGradientWidth := FMaxHue; // We want to skip the point at 360° --> no +1
FGradientHeight := FMaxSat + 1;
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
FHue := 0;
FSat := 1.0;
FLum := 0.5;
- FLumSel := 0.5;
+ FLumDisp := 0.5;
+ FVal := 1.0;
+ FValDisp := 1.0;
FSelected := clRed;
CreateGradient;
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
MarkerStyle := msCross;
end;
-procedure THSColorPicker.CorrectCoords(var x, y: integer);
-begin
- Clamp(x, 0, Width - 1);
- Clamp(y, 0, Height - 1);
-end;
-
procedure THSColorPicker.CreateWnd;
begin
inherited;
@@ -101,16 +84,10 @@ end;
procedure THSColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
- L: Double;
+ dummy: Double = 0;
begin
CorrectCoords(x, y);
-
- {$IFDEF USE_COLOR_TO_RGB}
- ColorToHSL(FSelected, FHue, FSat, L);
- {$ELSE}
- RGBToHSL(FSelected, FHue, FSat, L);
- {$ENDIF}
-
+ ColorToHSLV(FSelected, FHue, FSat, dummy, dummy);
if Focused or (csDesigning in ComponentState) then
c := clBlack
else
@@ -124,13 +101,9 @@ var
begin
if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then
begin
- H := x / (Width - 1);
+ H := x / Width; // Width = FMaxHue
S := 1 - y / (Height - 1);
- {$IFDEF USE_COLOR_TO_RGB}
- Result := HSLToColor(H, S, FLumSel);
- {$ELSE}
- Result := HSLToRGB(H, S, FLumSel);
- {$ENDIF}
+ Result := HSLVtoColor(H, S, FLum, FVal);
end else
Result := clNone;
end;
@@ -141,121 +114,12 @@ var
begin
H := x / FMaxHue;
S := 1 - y / FMaxSat;
- {$IFDEF USE_COLOR_TO_RGB}
- Result := HSLToColor(H, S, FLum);
- {$ELSE}
- Result := HSLtoRGB(H, S, FLum);
- {$ENDIF}
-end;
-
-function THSColorPicker.GetHue: Integer;
-begin
- Result := Round(FHue * (FMaxHue + 1));
-end;
-
-function THSColorPicker.GetLum: Integer;
-begin
- Result := Round(FLum * FMaxLum);
-end;
-
-function THSColorPicker.GetSat: Integer;
-begin
- Result := Round(FSat * FMaxSat);
+ Result := HSLVtoColor(H, S, FLumDisp, FValDisp);
end;
function THSColorPicker.GetSelectedColor: TColor;
begin
- {$IFDEF USE_COLOR_TO_RGB}
- Result := HSLToColor(FHue, FSat, FLumSel);
- {$ELSE}
- Result := HSLtoRGB(FHue, FSat, FLumSel);
- {$ENDIF}
-end;
-
-procedure THSColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
-var
- eraseKey: Boolean;
- delta: Integer;
-begin
- eraseKey := true;
- delta := IfThen(ssCtrl in Shift, 10, 1);
-
- case Key of
- VK_LEFT : SelectColor(mx - delta, my);
- VK_RIGHT : SelectColor(mx + delta, my);
- VK_UP : SelectColor(mx, my - delta);
- VK_DOWN : SelectColor(mx, my + delta);
- else eraseKey := false;
- end;
- {
- case Key of
- VK_LEFT:
- begin
- mxx := dx - delta;
- myy := dy;
- FSelected := GetColorAtPoint(mxx, myy);
- if Assigned(OnChange) then OnChange(Self);
- FManual := true;
- Invalidate;
- end;
- VK_RIGHT:
- begin
- mxx := dx + delta;
- myy := dy;
- FSelected := GetColorAtPoint(mxx, myy);
- if Assigned(OnChange) then OnChange(Self);
- FManual := true;
- Invalidate;
- end;
- VK_UP:
- begin
- mxx := dx;
- myy := dy - delta;
- FSelected := GetColorAtPoint(mxx, myy);
- if Assigned(OnChange) then OnChange(Self);
- FManual := true;
- Invalidate;
- end;
- VK_DOWN:
- begin
- mxx := dx;
- myy := dy + delta;
- FSelected := GetColorAtPoint(mxx, myy);
- if Assigned(OnChange) then OnChange(Self);
- FManual := true;
- Invalidate;
- end;
- else
- eraseKey := false;
- end;
- }
-
- if eraseKey then
- Key := 0;
-
- inherited;
-end;
-
-procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if Button = mbLeft then
- SelectColor(x, y);
- SetFocus;
-end;
-
-procedure THSColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if ssLeft in Shift then
- SelectColor(x, y);
-end;
-
-procedure THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if Button = mbLeft then
- SelectColor(x, y);
+ Result := HSLVtoColor(FHue, FSat, FLum, FVal);
end;
procedure THSColorPicker.Paint;
@@ -265,15 +129,8 @@ begin
end;
function THSColorPicker.PredictColor: TColor;
-var
- H, S, L: Double;
begin
- {$IFDEF USE_COLOR_TO_RGB}
- ColorToHSL(GetColorUnderCursor, H, S, L);
- {$ELSE}
- RGBtoHSL(GetColorUnderCursor, H, S, L);
- {$ENDIF}
- Result := HSLToRGB(H, S, L);
+ Result := GetColorUnderCursor;
end;
procedure THSColorPicker.Resize;
@@ -284,7 +141,10 @@ end;
procedure THSColorPicker.SelectColor(x, y: Integer);
var
- H, S, L: Double;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
c: TColor;
begin
CorrectCoords(x, y);
@@ -292,129 +152,59 @@ begin
my := y;
c := GetColorAtPoint(x, y);
if WebSafe then c := GetWebSafe(c);
- {$IFDEF USE_COLOR_TO_RGB}
- ColorToHSL(c, H, S, L);
- {$ELSE}
- RGBtoHSL(c, H, S, L);
- {$ENDIF}
+ ColorToHSLV(c, H, S, L, V);
if (H = FHue) and (S = FSat) then
exit;
FHue := H;
FSat := S;
- {$IFDEF USE_COLOR_TO_RGB}
- FSelected := ColorToHSL(FHue, FSat, FLumSel);
- {$ELSE}
- FSelected := HSLToRGB(FHue, FSat, FLumSel);
- {$ENDIF}
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
Invalidate;
DoChange;
end;
-(*
- BeginUpdate;
- try
- mxx := x;
- myy := y;
- CorrectCoords(mxx, myy);
- c := GetColorAtPoint(mxx, myy);
- if WebSafe then c := GetWebSafe(c);
- {$IFDEF USE_COLOR_TO_RGB}
- ColorToHSL(c, FHue, FSat, L);
- {$ELSE}
- RGBtoHSL(c, FHue, FSat, L);
- {$ENDIF}
- FSelected := c;
- FManual := false;
- Invalidate;
- finally
- EndUpdate;
- end;
-end;
-*)
-
-procedure THSColorPicker.SetHue(H: integer);
-begin
- Clamp(H, 0, FMaxHue);
- if H = GetHue then
- exit;
-
- FHue := H / (FMaxHue + 1);
- {$IFDEF USE_COLOR_TO_RGB}
- FSelected := HSLtoColor(FHue, FSat, FLumSel);
- {$ELSE}
- FSelected := HSLToRGB(FHue, FSat, FLumSel);
- {$ENDIF}
- UpdateCoords;
- Invalidate;
- DoChange;
-(*
- {$IFDEF USE_COLOR_TO_RGB}
- SetSelectedColor(HSLtoColor(FHue, FSat, FLumSel));
- {$ELSE}
- SetSelectedColor(HSLToRGB(FHue, FSat, FLumSel));
- {$ENDIF}
- *)
-end;
-
-// Sets the luminance value used for the display. It is not necessarily that
-// of the selected color.
-// The true luminance of the selected color is given by LumSel
-procedure THSColorPicker.SetLum(L: Integer);
-begin
- Clamp(L, 0, FMaxLum);
- if L = GetLum then
- exit;
-
- FLum := L / FMaxLum;
- CreateGradient;
- Invalidate;
- DoChange;
-end;
-
-procedure THSColorPicker.SetSat(S: integer);
-begin
- Clamp(S, 0, FMaxSat);
- if S = GetSat then
- exit;
-
- FSat := S / FMaxSat;
- FSelected := HSLToRGB(FHue, FSat, FLumSel);
- UpdateCoords;
- Invalidate;
- DoChange;
-end;
-
procedure THSColorPicker.SetMaxHue(H: Integer);
begin
if H = FMaxHue then
exit;
- FMaxHue := H;
- FGradientWidth := FMaxHue + 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);
+ FGradientWidth := H + 1;
+ inherited;
end;
procedure THSColorPicker.SetMaxSat(S: Integer);
begin
if S = FMaxSat then
exit;
- FMaxSat := S;
- FGradientHeight := FMaxSat + 1;
- CreateGradient;
+ FGradientHeight := S + 1;
+ inherited;
+end;
+
+procedure THSColorPicker.SetRelHue(H: Double);
+begin
+ Clamp(H, 0, 1 - 1/FMaxHue); // Don't use H=360°
+ if H = FHue then
+ exit;
+
+ FHue := H;
+ FSelected := GetSelectedColor;
+ UpdateCoords;
Invalidate;
+ DoChange;
+end;
+
+procedure THSColorPicker.SetRelSat(S: Double);
+begin
+ Clamp(S, 0.0, 1.0);
+ if S = FSat then
+ exit;
+
+ FSat := S;
+ FSelected := GetSelectedColor;
+ UpdateCoords;
+ Invalidate;
+ DoChange;
end;
// NOTE: In the picker display only the hue and the saturation of the input
@@ -423,31 +213,32 @@ end;
// input color.
procedure THSColorPicker.SetSelectedColor(c: TColor);
var
- H, S, L: Double;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
begin
if WebSafe then
c := GetWebSafe(c);
- {$IFDEF USE_COLOR_TO_RGB}
- ColorToHSL(c, H, S, L);
- {$ELSE}
- RGBtoHSL(c, H, S, L);
- {$ENDIF}
-
- FSelected := c;
+ ColorToHSLV(c, H, S, L, V);
if (H = FHue) and (S = FSat) then
exit;
+ FSelected := c;
FHue := H;
FSat := S;
- FLumSel := L;
+ case BrightnessMode of
+ bmLuminance : FLum := L;
+ bmValue : FVal := V;
+ end;
UpdateCoords;
Invalidate;
DoChange;
end;
-procedure THSCOlorPicker.UpdateCoords;
+procedure THSColorPicker.UpdateCoords;
begin
mx := Round(FHue * Width);
my := Round((1.0 - FSat) * Height);
diff --git a/components/mbColorLib/HSLColorPicker.pas b/components/mbColorLib/HSLColorPicker.pas
index 8d591ad85..72ab52f30 100644
--- a/components/mbColorLib/HSLColorPicker.pas
+++ b/components/mbColorLib/HSLColorPicker.pas
@@ -7,54 +7,76 @@ unit HSLColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
- HTMLColors, RGBHSLUtils, HSColorPicker, LColorPicker, mbBasicPicker;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
+ HTMLColors, mbColorConv, HSColorPicker, LVColorPicker, mbBasicPicker;
type
THSLColorPicker = class(TmbBasicPicker)
private
FHSPicker: THSColorPicker;
- FLPicker: TLColorPicker;
- FSelectedColor: TColor;
- FRValue, FGValue, FBValue: integer;
- FHSHint, FLHint: string;
- FLMenu, FHSMenu: TPopupMenu;
- FLumIncrement: integer;
- FHSCursor, FLCursor: TCursor;
+ FLVPicker: TLVColorPicker;
+ FRed, FGreen, FBlue: integer;
+ FHSHint: string;
+ FLVMenu, FHSMenu: TPopupMenu;
+ FLVIncrement: integer;
+ FHSCursor, FLVCursor: TCursor;
PBack: TBitmap;
- function GetH: Integer;
- function GetS: Integer;
- function GetL: Integer;
- function GetMaxH: Integer;
- function GetMaxS: Integer;
- function GetMaxL: Integer;
- procedure SetH(H: integer);
- procedure SetS(S: integer);
- procedure SetL(L: integer);
- procedure SetLumIncrement(i: integer);
- procedure SetMaxH(H: Integer);
- procedure SetMaxS(S: Integer);
- procedure SetMaxL(L: Integer);
- procedure SetR(R: integer);
- procedure SetG(G: integer);
- procedure SetB(B: integer);
- procedure SetHSHint(h: string);
- procedure SetLHint(h: string);
- procedure SetLMenu(m: TPopupMenu);
- procedure SetHSMenu(m: TPopupMenu);
+ function GetBrightnessMode: TBrightnessMode;
+ function GetHue: Integer;
+ function GetSat: Integer;
+ function GetLum: Integer;
+ function GetVal: Integer;
+ function GetMaxHue: Integer;
+ function GetMaxSat: Integer;
+ function GetMaxLum: Integer;
+ function GetMaxVal: Integer;
+ function GetRelHue: Double;
+ function GetRelSat: Double;
+ function GetRelLum: Double;
+ function GetRelVal: Double;
+ function GetLVHint(AMode: TBrightnessMode): String;
+
+ procedure SetBrightnessMode(AMode: TBrightnessMode);
+
+ procedure SetHue(H: integer);
+ procedure SetSat(S: integer);
+ procedure SetLum(L: integer);
+ procedure SetVal(V: Integer);
+
+ procedure SetMaxHue(H: Integer);
+ procedure SetMaxLum(L: Integer);
+ procedure SetMaxSat(S: Integer);
+ procedure SetMaxVal(V: Integer);
+
+ procedure SetRed(R: integer);
+ procedure SetGreen(G: integer);
+ procedure SetBlue(B: integer);
+
+ procedure SetRelHue(H: Double);
+ procedure SetRelLum(L: Double);
+ procedure SetRelSat(S: Double);
+ procedure SetRelVal(V: Double);
+
procedure SetHSCursor(c: TCursor);
- procedure SetLCursor(c: TCursor);
- procedure SetSelectedColor(Value: TColor);
+ procedure SetHSHint(h: string);
+ procedure SetHSMenu(m: TPopupMenu);
+
+ procedure SetLVCursor(c: TCursor);
+ procedure SetLVHint(AMode: TBrightnessMode; AText: string);
+ procedure SetLVMenu(m: TPopupMenu);
+ procedure SetLVIncrement(i: integer);
+
protected
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
+ function GetSelectedColor: TColor; override;
procedure HSPickerChange(Sender: TObject);
- procedure LPickerChange(Sender: TObject);
+ procedure LVPickerChange(Sender: TObject);
procedure Paint; override;
procedure Resize; override;
- procedure SelectColor(c: TColor);
+ procedure SetSelectedColor(Value: TColor); override;
+
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -62,24 +84,33 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
- property Red: integer read FRValue write SetR;
- property Green: integer read FGValue write SetG;
- property Blue: integer read FBValue write SetB;
+ property Red: integer read FRed write SetRed;
+ property Green: integer read FGreen write SetGreen;
+ property Blue: integer read FBlue write SetBlue;
+ property RelHue: Double read GetRelHue write SetRelHue;
+ property RelSaturation: Double read GetRelSat write SetRelSat;
+ property RelLuminance: Double read GetRelLum write SetRelLum;
+ property RelValue: Double read GetRelVal write SetRelVal;
published
- property Hue: integer read GetH write SetH default 0;
- property Saturation: integer read GetS write SetS default 240;
- property Luminance: integer read GetL write SetL default 120;
- property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1;
- property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed;
+ property BrightnessMode: TBrightnessMode read GetBrightnessMode
+ write SetBrightnessMode default bmLuminance;
+ property Hue: integer read GetHue write SetHue default 0;
+ property Saturation: integer read GetSat write SetSat default 255;
+ property Luminance: integer read GetLum write SetLum default 127;
+ property LVIncrement: integer read FLVIncrement write SetLVIncrement default 1;
+ property Value: Integer read GetVal write SetVal default 255;
+ property SelectedColor default clRed;
property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu;
- property LPickerPopupMenu: TPopupMenu read FLMenu write SetLMenu;
+ property LVPickerPopupMenu: TPopupMenu read FLVMenu write SetLVMenu;
property HSPickerHintFormat: string read FHSHint write SetHSHint;
- property LPickerHintFormat: string read FLHint write SetLHint;
+ property LPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint;
+ property VPickerHintFormat: string index bmValue read GetLVHint write SetLVHint;
property HSPickerCursor: TCursor read FHSCursor write SetHSCursor 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 LVPickerCursor: TCursor read FLVCursor write SetLVCursor default crDefault;
+ property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
+ property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 255;
+ property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 127;
+ property MaxValue: Integer read GetMaxVal write SetMaxVal default 255;
property TabStop default true;
property ShowHint;
property ParentShowHint;
@@ -98,7 +129,7 @@ type
implementation
-{THSLColorPicker}
+{ THSLColorPicker }
uses
mbTrackbarPicker;
@@ -112,9 +143,10 @@ begin
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 206, 146);
TabStop := true;
- FLumIncrement := 1;
+
+ FLVIncrement := 1;
FHSCursor := crDefault;
- FLCursor := crDefault;
+ FLVCursor := crDefault;
FHSPicker := THSColorPicker.Create(Self);
InsertControl(FHSPicker);
@@ -122,36 +154,45 @@ begin
begin
SetInitialBounds(0, 6, 174, 134);
Anchors := [akLeft, akTop, akRight, akBottom];
- Visible := true;
- MaxHue := 359;
- MaxSaturation := 240;
- MaxLuminance := 240;
+ // Visible := true;
+ BrightnessMode := bmLuminance;
+ MaxHue := 360;
+ MaxSaturation := 255;
+ MaxLuminance := 255;
+ MaxValue := 255;
OnChange := HSPickerChange;
OnMouseMove := DoMouseMove;
end;
- FLPicker := TLColorPicker.Create(Self);
- InsertControl(FLPicker);
- with FLPicker do
+ FLVPicker := TLVColorPicker.Create(Self);
+ InsertControl(FLVPicker);
+ with FLVPicker do
begin
Layout := lyVertical;
SetInitialBounds(184, 0, 25, 146);
Anchors := [akRight, akTop, akBottom];
- Visible := true;
+// Visible := true;
+ BrightnessMode := bmLuminance;
MaxHue := FHSPicker.MaxHue;
MaxSaturation := FHSPicker.MaxSaturation;
MaxLuminance := FHSPicker.MaxLuminance;
+ MaxValue := FHSPicker.MaxValue;
Luminance := MaxLuminance div 2;
- OnChange := LPickerChange;
+ Value := MaxValue;
+ OnChange := LVPickerChange;
OnMouseMove := DoMouseMove;
end;
Hue := 0;
Saturation := FHSPicker.MaxLuminance;
Luminance := FHSPicker.MaxLuminance div 2;
+ Value := FHSPicker.MaxValue;
- FHSHint := 'H: %h S: %hslS'#13'Hex: %hex';
- FLHint := 'Luminance: %l';
+ HSPickerHintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
+ {
+ FLVHint[bmLuminance] := 'Luminance: %l';
+ FLVHint[bmValue] := 'Value: %v';
+ }
end;
destructor THSLColorPicker.Destroy;
@@ -161,27 +202,35 @@ begin
end;
procedure THSLColorPicker.DoChange;
+var
+ c: TColor;
begin
- FSelectedColor := FLPicker.SelectedColor;
- FRValue := GetRValue(FSelectedColor);
- FGValue := GetGValue(FSelectedColor);
- FBValue := GetBValue(FSelectedColor);
+ c := FLVPicker.SelectedColor;
+ FRed := GetRValue(c);
+ FGreen := GetGValue(c);
+ FBlue := GetBValue(c);
inherited;
end;
-procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState;
+ X, Y: Integer);
begin
if Assigned(OnMouseMove) then
OnMouseMove(Self, Shift, x, y);
inherited;
end;
+function THSLColorPicker.GetBrightnessMode: TBrightnessMode;
+begin
+ Result := FHSPicker.BrightnessMode;
+end;
+
function THSLColorPicker.GetColorUnderCursor: TColor;
begin
Result := FHSPicker.ColorUnderCursor;
end;
-function THSLColorPicker.GetH: Integer;
+function THSLColorPicker.GetHue: Integer;
begin
Result := FHSPicker.Hue;
end;
@@ -191,46 +240,89 @@ begin
Result := FHSPicker.GetHexColorUnderCursor;
end;
-function THSLColorPicker.GetS: Integer;
+function THSLColorPicker.GetSat: Integer;
begin
Result := FHSPicker.Saturation;
end;
-function THSLColorPicker.GetL: integer;
+function THSLColorPicker.GetLum: integer;
begin
- Result := FLPicker.Luminance;
+ Result := FLVPicker.Luminance;
end;
-function THSLColorPicker.GetMaxH: Integer;
+function THSLColorPicker.GetVal: Integer;
+begin
+ Result := FLVPicker.Value;
+end;
+
+function THSLColorPicker.GetMaxHue: Integer;
begin
Result := FHSPicker.MaxHue;
end;
-function THSLColorPicker.GetMaxS: Integer;
+function THSLColorPicker.GetMaxSat: Integer;
begin
Result := FHSPicker.MaxSaturation;
end;
-function THSLColorPicker.GetMaxL: Integer;
+function THSLColorPicker.GetMaxLum: Integer;
begin
- Result := FLPicker.MaxLuminance;
+ Result := FLVPicker.MaxLuminance;
+end;
+
+function THSLColorPicker.GetMaxVal: Integer;
+begin
+ Result := FLVPicker.MaxValue;
+end;
+
+function THSLColorPicker.GetRelHue: Double;
+begin
+ Result := FHSPicker.RelHue;
+end;
+
+function THSLColorPicker.GetRelLum: Double;
+begin
+ Result := FLVPicker.RelLuminance;
+end;
+
+function THSLColorPicker.GetRelSat: Double;
+begin
+ Result := FHSPicker.RelSaturation;
+end;
+
+function THSLColorPicker.GetRelVal: Double;
+begin
+ Result := FLVPicker.RelValue;
+end;
+
+function THSLColorPicker.GetLVHint(AMode: TBrightnessMode): String;
+begin
+ case AMode of
+ bmLuminance: Result := FLVPicker.LHintFormat;
+ bmValue : Result := FLVPicker.VHintFormat;
+ end;
+end;
+
+function THSLColorPicker.GetSelectedColor: TColor;
+begin
+ Result := FLVPicker.SelectedColor;
end;
function THSLColorPicker.GetSelectedHexColor: string;
begin
- Result := ColorToHex(FSelectedColor);
+ Result := ColorToHex(GetSelectedColor);
end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject);
begin
- if FHSPicker.Hue <> FLPicker.Hue then
- FLPicker.Hue := FHSPicker.Hue;
- if FHSPicker.Saturation <> FLPicker.Saturation then
- FLPicker.Saturation := FHSPicker.Saturation;
+ if FHSPicker.Hue <> FLVPicker.Hue then
+ FLVPicker.Hue := FHSPicker.Hue;
+ if FHSPicker.Saturation <> FLVPicker.Saturation then
+ FLVPicker.Saturation := FHSPicker.Saturation;
DoChange;
end;
-procedure THSLColorPicker.LPickerChange(Sender: TObject);
+procedure THSLColorPicker.LVPickerChange(Sender: TObject);
begin
DoChange;
end;
@@ -239,14 +331,14 @@ procedure THSLColorPicker.Resize;
begin
inherited;
- if (FHSPicker = nil) or (FLPicker = nil) then
+ if (FHSPicker = nil) or (FLVPicker = nil) then
exit;
- FHSPicker.Width := Width - FLPicker.Width - 15;
+ FHSPicker.Width := Width - FLVPicker.Width - 15;
FHSPicker.Height := Height - 12;
- FLPicker.Left := Width - FLPicker.Width - 2;
- FLPicker.Height := Height; // - 12;
+ FLVPicker.Left := Width - FLVPicker.Width - 2;
+ FLVPicker.Height := Height; // - 12;
end;
procedure THSLColorPicker.Paint;
@@ -255,17 +347,16 @@ begin
Canvas.Draw(0, 0, PBack);
end;
-procedure THSLColorPicker.SelectColor(c: TColor);
+procedure THSLColorPicker.SetBlue(B: integer);
begin
- FSelectedColor := c;
- FHSPicker.SelectedColor := c;
- FLPicker.SelectedColor := c;
+ FBlue := B;
+ SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
end;
-procedure THSLColorPicker.SetB(B: integer);
+procedure THSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
- FBValue := B;
- SetSelectedColor(RGB(FRValue, FGValue, FBValue));
+ FHSPicker.BrightnessMode := AMode;
+ FLVPicker.BrightnessMode := AMode;
end;
procedure THSLColorPicker.SetFocus;
@@ -274,16 +365,16 @@ begin
FHSPicker.SetFocus;
end;
-procedure THSLColorPicker.SetG(G: integer);
+procedure THSLColorPicker.SetGreen(G: integer);
begin
- FGValue := G;
- SetSelectedColor(RGB(FRValue, FGValue, FBValue));
+ FGreen := G;
+ SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
end;
-procedure THSLColorPicker.SetH(H: integer);
+procedure THSLColorPicker.SetHue(H: integer);
begin
FHSPicker.Hue := H;
- FLPicker.Hue := H;
+ FLVPicker.Hue := H;
end;
procedure THSLColorPicker.SetHSCursor(c: TCursor);
@@ -304,84 +395,124 @@ begin
FHSPicker.PopupMenu := m;
end;
-procedure THSLColorPicker.SetL(L: integer);
+procedure THSLColorPicker.SetLum(L: integer);
begin
- FLPicker.Luminance := L;
+ FLVPicker.Luminance := L;
end;
-procedure THSLColorPicker.SetLHint(h: string);
+procedure THSLColorPicker.SetLVCursor(c: TCursor);
begin
- FLHint := h;
- FLPicker.HintFormat := h;
+ FLVCursor := c;
+ FLVPicker.Cursor := c;
end;
-procedure THSLColorPicker.SetLMenu(m: TPopupMenu);
+procedure THSLColorPicker.SetLVHint(AMode: TBrightnessMode; AText: string);
begin
- FLMenu := m;
- FLPicker.PopupMenu := m;
-end;
-
-procedure THSLColorPicker.SetLumIncrement(i: integer);
-begin
- FLumIncrement := i;
- FLPicker.Increment := i;
-end;
-
-procedure THSLColorPicker.SetLCursor(c: TCursor);
-begin
- FLCursor := c;
- FLPicker.Cursor := c;
-end;
-
-procedure THSLColorPicker.SetMaxH(H: Integer);
-begin
- FHSPicker.MaxHue := H;
- FLPicker.MaxHue := H;
-end;
-
-procedure THSLColorPicker.SetMaxL(L: Integer);
-begin
- FHSPicker.MaxLuminance := L;
- FLPicker.MaxLuminance := L;
-end;
-
-procedure THSLColorPicker.SetMaxS(S: Integer);
-begin
- FHSPicker.MaxSaturation := S;
- FLPicker.MaxSaturation := S;
-end;
-
-procedure THSLColorPicker.SetR(R: integer);
-begin
- FRValue := R;
- SetSelectedColor(RGB(FRValue, FGValue, FBValue));
-end;
-
-procedure THSLColorPicker.SetS(S: integer);
-begin
- if S <> FHSPicker.Saturation then
- FHSPicker.Saturation := S;
- if S <> FLPicker.Saturation then
- FLPicker.Saturation := S;
-end;
-
-procedure THSLColorPicker.SetSelectedColor(Value: TColor);
-begin
- if FSelectedColor <> Value then
- begin
- SelectColor(Value);
- //FLPicker.Hue := FHSPicker.HueValue;
- //FLPicker.Saturation := FHSPicker.SaturationValue;
+ case AMode of
+ bmLuminance: FLVPicker.LHintFormat := AText;
+ bmValue : FLVPicker.VHintFormat := AText;
end;
end;
-(*
-procedure THSLColorPicker.WMSetFocus(
- var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
+procedure THSLColorPicker.SetLVIncrement(i: integer);
begin
- FHSPicker.SetFocus;
- Message.Result := 1;
+ FLVIncrement := i;
+ FLVPicker.Increment := i;
end;
- *)
+
+procedure THSLColorPicker.SetLVMenu(m: TPopupMenu);
+begin
+ FLVMenu := m;
+ FLVPicker.PopupMenu := m;
+end;
+
+procedure THSLColorPicker.SetMaxHue(H: Integer);
+begin
+ FHSPicker.MaxHue := H;
+ FLVPicker.MaxHue := H;
+end;
+
+procedure THSLColorPicker.SetMaxLum(L: Integer);
+begin
+ FHSPicker.MaxLuminance := L;
+ FLVPicker.MaxLuminance := L;
+end;
+
+procedure THSLColorPicker.SetMaxSat(S: Integer);
+begin
+ FHSPicker.MaxSaturation := S;
+ FLVPicker.MaxSaturation := S;
+end;
+
+procedure THSLColorPicker.SetMaxVal(V: Integer);
+begin
+ FLVPicker.MaxValue := V;
+end;
+
+procedure THSLColorPicker.SetRed(R: integer);
+begin
+ FRed := R;
+ SetSelectedColor(RGBtoColor(FRed, FGreen, FBlue));
+end;
+
+procedure THSLColorPicker.SetRelHue(H: Double);
+begin
+ FHSPicker.RelHue := H;
+ FLVPicker.RelHue := H;
+end;
+
+procedure THSLCOlorPicker.SetRelSat(S: Double);
+begin
+ FHSPicker.RelSaturation := S;
+ FLVPicker.RelSaturation := S;
+end;
+
+procedure THSLColorPicker.SetRelLum(L: Double);
+begin
+ FHSPicker.RelLuminance := L;
+ FLVPicker.RelLuminance := L;
+end;
+
+procedure THSLColorPicker.SetRelVal(V: Double);
+begin
+ FHSPicker.RelValue := V;
+ FLVPicker.RelValue := V;
+end;
+
+procedure THSLColorPicker.SetSat(S: integer);
+begin
+ if S <> FHSPicker.Saturation then
+ FHSPicker.Saturation := S;
+ if S <> FLVPicker.Saturation then
+ FLVPicker.Saturation := S;
+end;
+
+procedure THSLColorPicker.SetSelectedColor(Value: TColor);
+var
+ c: TColor;
+ H: Double = 0;
+ S: Double = 0;
+ LV: Double = 0;
+begin
+ c := GetSelectedColor;
+ if c <> Value then
+ begin
+ case GetBrightnessMode of
+ bmLuminance: ColorToHSL(c, H, S, LV);
+ bmValue : ColorToHSV(c, H, S, LV);
+ end;
+// FSelectedColor := c;
+ FHSPicker.RelHue := H;
+ FHSPicker.RelSaturation := S;
+// FHSPicker.SelectedColor := c;
+ FLVPicker.SelectedColor := c;
+ end;
+end;
+
+procedure THSLColorPicker.SetVal(V: Integer);
+begin
+ FLVPicker.Value := V;
+end;
+
end.
diff --git a/components/mbColorLib/HSLRingPicker.pas b/components/mbColorLib/HSLRingPicker.pas
index 12fafd82c..935e51e02 100644
--- a/components/mbColorLib/HSLRingPicker.pas
+++ b/components/mbColorLib/HSLRingPicker.pas
@@ -9,7 +9,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics,
Forms, Menus, Math, Themes,
- RGBHSLUtils, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
+ mbColorConv, HRingPicker, SLColorPicker, HTMLColors, mbBasicPicker;
type
THSLRingPicker = class(TmbBasicPicker)
@@ -17,41 +17,50 @@ type
FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker;
FSelectedColor: TColor;
- FRValue, FGValue, FBValue: integer;
+// FRValue, FGValue, FBValue: integer;
FRingHint, FSLHint: string;
FSLMenu, FRingMenu: TPopupMenu;
FSLCursor, FRingCursor: TCursor;
PBack: TBitmap;
+ function GetBrightnessMode: TBrightnessMode;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
+ function GetVal: Integer;
function GetMaxHue: Integer;
function GetMaxLum: Integer;
function GetMaxSat: Integer;
+ function GetRed: Integer;
+ function GetGreen: Integer;
+ function GetBlue: Integer;
+ function GetLVHint(AMode: TBrightnessMode): String;
+ procedure SetBrightnessMode(AMode: TBrightnessMode);
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
+ procedure SetVal(V: Integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
- procedure SetR(v: integer);
- procedure SetG(v: integer);
- procedure SetB(v: integer);
+ procedure SetRed(R: integer);
+ procedure SetGreen(G: integer);
+ procedure SetBlue(B: integer);
procedure SetRingHint(h: string);
- procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu);
procedure SetRingMenu(m: TPopupMenu);
procedure SetRingCursor(c: TCursor);
procedure SetSLCursor(c: TCursor);
+ procedure SetLVHint(AMode: TBrightnessMode; AText: String);
protected
- procedure CreateWnd; override;
+// procedure CreateWnd; override;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
+ function GetSelectedColor: TColor; override;
procedure Paint; override;
procedure Resize; override;
procedure RingPickerChange(Sender: TObject);
- procedure SelectColor(c: TColor);
+ procedure SetSelectedColor(c: TColor); override;
procedure SLPickerChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
@@ -60,21 +69,25 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
- property Red: integer read FRValue write SetR;
- property Green: integer read FGValue write SetG;
- property Blue: integer read FBValue write SetB;
+ property Red: integer read GetRed write SetRed;
+ property Green: integer read GetGreen write SetGreen;
+ property Blue: integer read GetBlue write SetBlue;
published
+ property BrightnessMode: TBrightnessMode read GetBrightnessMode
+ write SetBrightnessMode default bmValue;
property Hue: integer read GetHue write SetHue default 0;
- property Saturation: integer read GetSat write SetSat default 240;
- property Luminance: integer read GetLum write SetLum default 120;
- property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
+ property Saturation: integer read GetSat write SetSat default 255;
+ property Luminance: integer read GetLum write SetLum default 127;
+ property Value: Integer read GetVal write SetVal default 255;
+ property SelectedColor default clRed;
property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
property RingPickerHintFormat: string read FRingHint write SetRingHint;
- property SLPickerHintFormat: string read FSLHint write SetSLHint;
+ property SLPickerHintFormat: string index bmLuminance read GetLVHint write SetLVHint;
+ property SVPickerHintFormat: String index bmValue read GetLVHint write SetLVHint;
property RingPickerCursor: TCursor read FRingCursor write SetRingCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
- property MaxHue: Integer read GetMaxHue write SetMaxHue default 359;
+ property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
property TabStop default true;
@@ -100,30 +113,20 @@ begin
inherited;
// ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque{$IFDEF DELPHI_7_UP}, csParentBackground{$ENDIF}];
- FRValue := 255;
- FGValue := 0;
- FBValue := 0;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 245, 245);
TabStop := true;
- FSelectedColor := clRed;
FRingCursor := crDefault;
FSLCursor := crDefault;
- FRingHint := 'Hue: %h';
- FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
FRingPicker := THRingPicker.Create(Self);
InsertControl(FRingPicker);
with FRingPicker do
begin
SetInitialBounds(0, 0, 246, 246);
- //Radius := 40;
+ BrightnessMode := bmValue;
Align := alClient;
- Visible := true;
- Saturation := FRingPicker.MaxSaturation;
- Value := FRingPicker.MaxValue;
- Hue := 0;
OnChange := RingPickerChange;
OnMouseMove := DoMouseMove;
end;
@@ -133,14 +136,14 @@ begin
with FSLPicker do
begin
SetInitialBounds(63, 63, 120, 120);
- MaxSaturation := 240;
- MaxLuminance := 240;
- Saturation := 240;
- Luminance := 240;
- Visible := true;
+ BrightnessMode := bmValue;
+ SLHintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
+ SVHintFormat := 'S: %hslS V: %v'#13'Hex: %hex';
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
+
+ SetSelectedColor(clRed);
end;
destructor THSLRingPicker.Destroy;
@@ -148,22 +151,16 @@ begin
PBack.Free;
inherited Destroy;
end;
-
+ (*
procedure THSLRingPicker.CreateWnd;
begin
inherited;
- PaintParentBack(PBack);
-end;
+ //PaintParentBack(PBack);
+end; *)
procedure THSLRingPicker.DoChange;
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
-
- FRValue := GetRValue(FSLPicker.SelectedColor);
- FGValue := GetGValue(FSLPicker.SelectedColor);
- FBValue := GetBValue(FSLPicker.SelectedColor);
-
+ FSelectedColor := FSLPicker.SelectedColor;
inherited;
end;
@@ -174,11 +171,26 @@ begin
inherited;
end;
+function THSLRingPicker.GetBlue: Integer;
+begin
+ Result := GetRValue(FSelectedColor);
+end;
+
+function THSLRingPicker.GetBrightnessMode: TBrightnessMode;
+begin
+ Result := FSLPicker.BrightnessMode;
+end;
+
function THSLRingPicker.GetColorUnderCursor: TColor;
begin
Result := FSLPicker.ColorUnderCursor;
end;
+function THSLRingPicker.GetGreen: Integer;
+begin
+ Result := GetGValue(FSelectedColor);
+end;
+
function THSLRingPicker.GetHexColorUnderCursor: string;
begin
Result := FSLPicker.GetHexColorUnderCursor;
@@ -194,6 +206,14 @@ begin
Result := FSLPicker.Luminance;
end;
+function THSLRingPicker.GetLVHint(AMode: TBrightnessMode): String;
+begin
+ case BrightnessMode of
+ bmLuminance: Result := FSLPicker.SLHintFormat;
+ bmValue : Result := FSLPicker.SVHintFormat;
+ end;
+end;
+
function THSLRingPicker.GetMaxHue: Integer;
begin
Result := FRingPicker.MaxHue;
@@ -209,16 +229,31 @@ begin
Result := FSLPicker.MaxLuminance;
end;
+function THSLRingPicker.GetRed: Integer;
+begin
+ Result := GetRValue(FSelectedColor);
+end;
+
function THSLRingPicker.GetSat: Integer;
begin
Result := FSLPicker.Saturation;
end;
+function THSLRingPicker.GetSelectedColor: TColor;
+begin
+ Result := FSelectedColor;
+end;
+
function THSLRingPicker.GetSelectedHexColor: string;
begin
Result := ColorToHex(FSelectedColor);
end;
+function THSLRingPicker.GetVal: Integer;
+begin
+ Result := FSLPicker.Value;
+end;
+
procedure THSLRingPicker.Paint;
begin
PaintParentBack(PBack);
@@ -250,8 +285,6 @@ end;
procedure THSLRingPicker.RingPickerChange(Sender: TObject);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
if FSLPicker.Hue <> FRingPicker.Hue then
begin
FSLPicker.Hue := FRingPicker.Hue;
@@ -259,23 +292,15 @@ begin
end;
end;
-procedure THSLRingPicker.SelectColor(c: TColor);
+procedure THSLRingPicker.SetBlue(B: integer);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
-
- FRingPicker.Hue := GetHValue(c);
- //FRingPicker.Saturation := FRingPicker.MaxSaturation;
- //FRingPicker.Value := FRingPicker.MaxValue;
-
- FSLPicker.SelectedColor := c;
- FSelectedColor := c;
+ SetSelectedColor(RgbToColor(Red, Green, B));
end;
-procedure THSLRingPicker.SetB(v: integer);
+procedure THSLRingPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
- FBValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FRingPicker.BrightnessMode := AMode;
+ FSLPicker.BrightnessMode := AMode;
end;
procedure THSLRingPicker.SetFocus;
@@ -284,47 +309,51 @@ begin
FRingPicker.SetFocus;
end;
-procedure THSLRingPicker.SetG(v: integer);
+procedure THSLRingPicker.SetGreen(G: integer);
begin
- FGValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ SetSelectedColor(RgbToColor(Red, G, Blue));
end;
procedure THSLRingPicker.SetHue(H: integer);
begin
- if (FRingPicker = nil) or (FSLPicker = nil) then
- exit;
-
FRingPicker.Hue := H;
FSLPicker.Hue := H;
end;
procedure THSLRingPicker.SetLum(L: integer);
begin
- if (FSLPicker = nil) then
- exit;
FSLPicker.Luminance := L;
end;
+procedure THSLRingPicker.SetLVHint(AMode: TBrightnessMode; AText: string);
+begin
+ case AMode of
+ bmLuminance: FSLPicker.SLHintFormat := AText;
+ bmValue : FSLPicker.SVHintFormat := AText;
+ end;
+end;
+
procedure THSLRingPicker.SetMaxHue(H: Integer);
begin
FRingPicker.MaxHue := H;
+ FSLPicker.MaxHue := H;
end;
procedure THSLRingPicker.SetMaxLum(L: Integer);
begin
+ FRingPicker.MaxLuminance := L;
FSLPicker.MaxLuminance := L;
end;
procedure THSLRingPicker.SetMaxSat(S: Integer);
begin
+ FRingPicker.MaxSaturation := S;
FSLPicker.MaxSaturation := S;
end;
-procedure THSLRingPicker.SetR(v: integer);
+procedure THSLRingPicker.SetRed(R: integer);
begin
- FRValue := v;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ SetSelectedColor(RgbToColor(R, Green, Blue));
end;
procedure THSLRingPicker.SetRingCursor(c: TCursor);
@@ -347,36 +376,45 @@ end;
procedure THSLRingPicker.SetSat(S: integer);
begin
- if (FSLPicker = nil) then
- exit;
FSLPicker.Saturation := S;
end;
+procedure THSLRingPicker.SetSelectedColor(c: TColor);
+var
+ H, S, LV: Double;
+begin
+ case BrightnessMode of
+ bmLuminance: ColorToHSL(c, H, S, LV);
+ bmValue : ColorToHSV(c, H, S, LV);
+ end;
+ FRingPicker.RelHue := H;
+ FSLPicker.SelectedColor := c;
+ FSelectedColor := FSLPicker.SelectedColor;
+end;
+
procedure THSLRingPicker.SetSLCursor(c: TCursor);
begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
-procedure THSLRingPicker.SetSLHint(h: string);
-begin
- FSLHint := h;
- FSLPicker.HintFormat := h;
-end;
-
procedure THSLRingPicker.SetSLMenu(m: TPopupMenu);
begin
FSLMenu := m;
FSLPicker.PopupMenu := m;
end;
+procedure THSLRingPicker.SetVal(V: integer);
+begin
+ FSLPicker.Value := V;
+end;
+
procedure THSLRingPicker.SLPickerChange(Sender: TObject);
begin
- if (FSLPicker <> nil) and (FSelectedColor <> FSLPicker.SelectedColor) then
- begin
- FSelectedColor := FSLPicker.SelectedColor;
- DoChange;
- end;
+ if FSelectedColor = FSLPicker.SelectedColor then
+ exit;
+ FSelectedColor := FSLPicker.SelectedColor;
+ DoChange;
end;
end.
diff --git a/components/mbColorLib/HSVColorPicker.pas b/components/mbColorLib/HSVColorPicker.pas
index 476c9baa9..1f463e42c 100644
--- a/components/mbColorLib/HSVColorPicker.pas
+++ b/components/mbColorLib/HSVColorPicker.pas
@@ -8,34 +8,17 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms, Themes,
- RGBHSVUtils, Scanlines, HTMLColors, mbColorPickerControl;
+ HTMLColors, mbColorConv, mbColorPickerControl;
type
- THSVColorPicker = class(TmbColorPickerControl)
+ THSVColorPicker = class(TmbHSLVColorPickerControl)
private
- FHue, FSat, FValue: Double;
- FMaxHue, FMaxSat, FMaxValue: Integer;
FSatCircColor, FHueLineColor: TColor;
- FSelectedColor: TColor;
FShowSatCirc: boolean;
FShowHueLine: boolean;
FShowSelCirc: boolean;
- function RadHue(New: integer): integer;
- function GetHue: Integer;
- function GetSat: Integer;
- function GetValue: Integer;
- function GetRed: Integer;
- function GetGreen: Integer;
- function GetBlue: Integer;
- procedure SetMaxHue(h: Integer);
- procedure SetMaxSat(s: Integer);
- procedure SetMaxValue(v: Integer);
- procedure SetHue(h: integer);
- procedure SetSat(s: integer);
- procedure SetValue(V: integer);
- procedure SetRed(r: Integer);
- procedure SetGreen(g: Integer);
- procedure SetBlue(b: Integer);
+ procedure SetRelHue(H: Double);
+ procedure SetRelSat(S: Double);
procedure SetSatCircColor(c: TColor);
procedure SetHueLineColor(c: TColor);
procedure DrawSatCirc;
@@ -47,31 +30,26 @@ type
procedure UpdateCoords;
protected
procedure CreateGradient; override;
- procedure CreateWnd; override;
+// procedure CreateWnd; override;
function GetGradientColor2D(X, Y: Integer): TColor; override;
- function GetSelectedColor: TColor; override;
procedure Paint; override;
procedure Resize; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure SelectColor(x, y: integer);
+ procedure SelectColor(x, y: integer); override;
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
- property Red: Integer read GetRed write SetRed;
- property Green: Integer read GetGreen write SetGreen;
- property Blue: Integer read GetBlue write SetBlue;
published
+ property BrightnessMode default bmValue;
property SelectedColor default clRed;
- property Hue: integer read GetHue write SetHue default 0;
- property Saturation: integer read GetSat write SetSat default 255;
- property Value: integer read GetValue write SetValue default 255;
- 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 Hue default 0;
+ property Luminance default 127;
+ property Saturation default 255;
+ property Value default 255;
+ property MaxHue default 360;
+ property MaxLuminance default 255;
+ property MaxSaturation default 255;
+ property MaxValue default 255;
property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true;
@@ -92,16 +70,14 @@ constructor THSVColorPicker.Create(AOwner: TComponent);
begin
inherited;
SetInitialBounds(0, 0, 204, 204);
- FMaxHue := 359;
- FMaxSat := 255;
- FMaxValue := 255;
FHue := 0;
FSat := 1.0;
- FValue := 1.0;
+ FLum := 0.5;
+ FVal := 1.0;
+ SetSelectedColor(clRed);
+ BrightnessMode := bmValue;
FSatCircColor := clSilver;
FHueLineColor := clGray;
- FSelectedColor := clRed;
- FManual := false;
FShowSatCirc := true;
FShowHueLine := true;
FShowSelCirc := true;
@@ -114,13 +90,13 @@ begin
FGradientHeight := FGradientWidth;
inherited;
end;
-
+ (*
procedure THSVColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
UpdateCoords;
-end;
+end; *)
procedure THSVColorPicker.DrawSatCirc;
var
@@ -171,11 +147,6 @@ begin
InternalDrawMarker(x, y, c);
end;
-function THSVColorPicker.GetBlue: Integer;
-begin
- Result := GetBValue(FSelectedColor);
-end;
-
function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
angle: Double;
@@ -196,7 +167,7 @@ begin
angle := angle - 360;
h := angle / 360;
s := r / radius;
- Result := HSVtoColor(h, s, FValue);
+ Result := HSLVtoColor(h, s, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
@@ -209,8 +180,7 @@ var
dx, dy: Integer;
dSq, radiusSq: Integer;
radius, size: Integer;
- S, H, V: Double;
- q: TRGBQuad;
+ S, H: Double;
begin
size := FGradientWidth; // or Height, they are the same...
radius := size div 2;
@@ -227,102 +197,13 @@ begin
H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90;
if H > 360 then H := H - 360;
- Result := HSVtoColor(H/360, S, FValue);
+ Result := HSLVtoColor(H/360, S, FLum, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
Result := GetDefaultColor(dctBrush);
end;
-function THSVColorPicker.GetGreen: Integer;
-begin
- Result := GetGValue(FSelectedColor);
-end;
-
-function THSVColorPicker.GetHue: Integer;
-begin
- Result := round(FHue * FMaxHue);
-end;
-
-function THSVColorPicker.GetRed: Integer;
-begin
- Result := GetRValue(FSelectedColor);
-end;
-
-function THSVColorPicker.GetSat: Integer;
-begin
- Result := round(FSat * FMaxSat);
-end;
-
-function THSVColorPicker.GetSelectedColor: TColor;
-begin
- if FSelectedColor <> clNone then
- begin
- Result := HSVtoColor(FHue, FSat, FValue);
- if WebSafe then
- Result := GetWebSafe(Result);
- end
- else
- Result := clNone;
-end;
-
-function THSVColorPicker.GetValue: Integer;
-begin
- Result := round(FValue * FMaxValue);
-end;
-
-procedure THSVColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
-var
- eraseKey: Boolean;
- delta: Integer;
-begin
- eraseKey := true;
- delta := IfThen(ssCtrl in shift, 10, 1);
-
- case Key of
- VK_LEFT : SetHue(RadHue(GetHue() + delta));
- VK_RIGHT : SetHue(RadHue(GetHue() - delta));
- VK_UP : SetSat(GetSat() + delta);
- VK_DOWN : SetSat(GetSat() - delta);
- else eraseKey := false;
- end;
-
- if eraseKey then
- Key := 0;
-
- inherited;
-end;
-
-procedure THSVColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- exit;
- if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
- SelectColor(X, Y);
- SetFocus;
-end;
-
-procedure THSVColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- exit;
- if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then
- SelectColor(X, Y);
-end;
-
-procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- exit;
- if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
- SelectColor(X, Y);
-end;
-
procedure THSVColorPicker.Paint;
var
rgn: HRGN;
@@ -342,13 +223,6 @@ begin
DrawMarker(mx, my);
end;
-function THSVColorPicker.RadHue(New: integer): integer;
-begin
- if New < 0 then New := New + (FMaxHue + 1);
- if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
- Result := New;
-end;
-
procedure THSVColorPicker.Resize;
begin
inherited;
@@ -393,48 +267,12 @@ begin
FHue := H;
FSat := S;
- FSelectedColor := HSVToColor(FHue, FSat, FValue);
+ FSelected := HSLVToColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
end;
-procedure THSVColorPicker.SetBlue(b: Integer);
-var
- c: TColor;
-begin
- Clamp(b, 0, 255);
- if b = GetBValue(FSelectedColor) then
- exit;
- c := RgbToColor(GetRValue(FSelectedColor), GetGValue(FSelectedColor), b);
- SetSelectedColor(c);
-end;
-
-procedure THSVColorPicker.SetGreen(g: Integer);
-var
- c: TColor;
-begin
- Clamp(g, 0, 255);
- if g = GetGValue(FSelectedColor) then
- exit;
- c := RgbToColor(GetRValue(FSelectedColor), g, GetBValue(FSelectedColor));
- SetSelectedColor(c);
-end;
-
-procedure THSVColorPicker.SetHue(h: integer);
-begin
- if h > FMaxHue then h := h - (FMaxHue + 1);
- if h < 0 then h := h + (FMaxHue + 1);
- if GetHue() <> h then
- begin
- FHue := h / FMaxHue;
- FSelectedColor := HSVToColor(FHue, FSat, FValue);
- UpdateCoords;
- Invalidate;
- DoChange;
- end;
-end;
-
procedure THSVColorPicker.SetHueLineColor(c: TColor);
begin
if FHueLineColor <> c then
@@ -444,54 +282,27 @@ begin
end;
end;
-procedure THSVColorPicker.SetMaxHue(h: Integer);
+procedure THSVColorPicker.SetRelHue(H: Double);
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.SetRed(r: Integer);
-var
- c: TColor;
-begin
- Clamp(r, 0, 255);
- if r = GetRValue(FSelectedColor) then
- exit;
- c := RgbToColor(r, GetGValue(FSelectedColor), GetBValue(FSelectedColor));
- SetSelectedColor(c);
-end;
-
-procedure THSVColorPicker.SetSat(s: integer);
-begin
- Clamp(s, 0, FMaxSat);
- if GetSat() <> s then
+ if H > 1 then H := H - 1;
+ if H < 0 then H := H + 1;
+ if FHue <> h then
begin
- FSat := s / FMaxSat;
- FSelectedColor := HSVToColor(FHue, FSat, FValue);
+ FHue := h;
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+ UpdateCoords;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure THSVColorPicker.SetRelSat(S: Double);
+begin
+ Clamp(S, 0.0, 1.0);
+ if FSat <> S then
+ begin
+ FSat := s;
+ FSelected := HSLVToColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
@@ -508,15 +319,13 @@ begin
end;
procedure THSVColorPicker.SetSelectedColor(c: TColor);
-var
- h, s, v: Double;
begin
if WebSafe then
c := GetWebSafe(c);
- if c = FSelectedColor then
+ if c = FSelected then
exit;
- RGBtoHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue);
- FSelectedColor := c;
+ ColorToHSLV(c, FHue, FSat, FLum, FVal);
+ FSelected := c;
UpdateCoords;
Invalidate;
DoChange;
@@ -549,19 +358,6 @@ begin
end;
end;
-procedure THSVColorPicker.SetValue(V: integer);
-begin
- Clamp(V, 0, FMaxValue);
- if GetValue() <> V then
- begin
- FValue := V / FMaxValue;
- FSelectedColor := HSVToColor(FHue, FSat, FValue);
- CreateGradient;
- Invalidate;
- DoChange;
- end;
-end;
-
procedure THSVColorPicker.UpdateCoords;
var
r, angle: double;
diff --git a/components/mbColorLib/HexaColorPicker.pas b/components/mbColorLib/HexaColorPicker.pas
index dcdc5915f..5d83aa809 100644
--- a/components/mbColorLib/HexaColorPicker.pas
+++ b/components/mbColorLib/HexaColorPicker.pas
@@ -11,8 +11,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, StdCtrls,
Forms, Themes, Math,
- HTMLColors, RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils,
- mbBasicPicker;
+ HTMLColors, mbBasicPicker;
const
CustomCell = -2;
@@ -90,7 +89,6 @@ type
procedure SetNewArrowStyle(Value: boolean);
procedure SetMarker(Value: TMarker);
procedure SetRadius(r: integer);
- procedure SetSelectedColor(const Value: TColor);
procedure SetSliderVisible(Value: boolean);
procedure SetSliderWidth(w: integer);
function SelectAvailableColor(Color: TColor): boolean;
@@ -100,6 +98,7 @@ type
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Paint; override;
procedure Resize; override;
+ procedure SetSelectedColor(Value: TColor); override;
procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
@@ -705,7 +704,7 @@ begin
FBWCombRect := Rect(
FColorCombRect.Left,
FColorCombRect.Bottom - 4,
- Round(17 * FCombSize * cos(Pi / 6) / 2) + 6 * FCombSize,
+ Round(17 * FCombSize * cos(Pi / 6) / 2) {%H-}+ 6 * FCombSize,
FColorCombRect.Bottom + 2 * FCombSize
);
if FSliderVisible then
@@ -977,7 +976,7 @@ begin
end;
end;
-procedure THexaColorPicker.SetSelectedColor(const Value: TColor);
+procedure THexaColorPicker.SetSelectedColor(Value: TColor);
begin
FCurrentColor := Value;
SelectColor(Value);
diff --git a/components/mbColorLib/KColorPicker.pas b/components/mbColorLib/KColorPicker.pas
index 9a8197dac..0d4d284c8 100644
--- a/components/mbColorLib/KColorPicker.pas
+++ b/components/mbColorLib/KColorPicker.pas
@@ -17,17 +17,17 @@ type
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromBlack(k: integer): integer;
function BlackFromArrowPos(p: integer): integer;
- function GetSelectedColor: TColor;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
- procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -35,8 +35,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 0;
property Yellow: integer read FYellow write SetYellow default 0;
property Black: integer read FBlack write SetBlack default 0;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
implementation
diff --git a/components/mbColorLib/LColorPicker.pas b/components/mbColorLib/LColorPicker.pas
index be78caf82..7165ca8fe 100644
--- a/components/mbColorLib/LColorPicker.pas
+++ b/components/mbColorLib/LColorPicker.pas
@@ -8,7 +8,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
- HTMLColors, RGBHSLUtils, mbTrackBarPicker;
+ HTMLColors, {RGBHSLUtils, }mbTrackBarPicker;
type
TLColorPicker = class(TmbTrackBarPicker)
@@ -19,7 +19,6 @@ type
function GetHue: Integer;
function GetLuminance: Integer;
function GetSat: Integer;
- function GetSelectedColor: TColor;
function LumFromArrowPos(p: integer): integer;
procedure SetHue(H: integer);
procedure SetLuminance(L: integer);
@@ -27,37 +26,39 @@ type
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure SetSat(S: integer);
- procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
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 MaxHue: Integer read FMaxHue write SetmaxHue default 360;
+ property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
+ property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
+ property SelectedColor default clRed;
+ property HintFormat;
end;
implementation
uses
- mbUtils;
+ mbUtils, mbColorConv;
{TLColorPicker}
constructor TLColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FMaxHue := 359;
- FMaxSat := 240;
- FMaxLum := 240;
+ FMaxHue := 360;
+ FMaxSat := 255;
+ FMaxLum := 255;
FGradientWidth := FMaxLum + 1;
FGradientHeight := 1;
FHue := 0;
@@ -130,7 +131,7 @@ end;
function TLColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
- Result := HSLToRGB(FHue, FSat, AValue/FMaxLum);
+ Result := HSLToColor(FHue, FSat, AValue/FMaxLum);
end;
function TLColorPicker.GetHue: Integer;
@@ -150,7 +151,7 @@ end;
function TLColorPicker.GetSelectedColor: TColor;
begin
- Result := HSLToRGB(FHue, FSat, FLuminance);
+ Result := HSLToColor(FHue, FSat, FLuminance);
if WebSafe then
Result := GetWebSafe(Result);
end;
@@ -165,8 +166,8 @@ var
L: integer;
begin
case Layout of
- lyHorizontal : L := Round(p / (Width - 12) * FMaxLum);
- lyVertical : L := Round(MaxLum - p /(Height - 12) * FMaxLum);
+ lyHorizontal : L := Round( p / (Width - 12) * FMaxLum);
+ lyVertical : L := Round((1.0 - p /(Height - 12)) * FMaxLum);
end;
Clamp(L, 0, FMaxLum);
Result := L;
@@ -193,7 +194,6 @@ begin
FArrowPos := ArrowPosFromLum(L);
Invalidate;
DoChange;
-// if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
@@ -250,8 +250,8 @@ begin
if c = GetSelectedColor then
exit;
-// ColortoHSL(c, FHue, FSat, FLuminance); // not working in HSLPicker
- RGBtoHSL(c, H, S, L);
+// ColortoHSL(c, H, S, L); // not working in HSLPicker
+ ColorToHSL(c, H, S, L);
needNewGradient := (H <> FHue) or (S <> FSat);
FHue := H;
FSat := S;
diff --git a/components/mbColorLib/LVColorPicker.pas b/components/mbColorLib/LVColorPicker.pas
new file mode 100644
index 000000000..debebd24b
--- /dev/null
+++ b/components/mbColorLib/LVColorPicker.pas
@@ -0,0 +1,335 @@
+{ A trackbar picker for Luminance or Value parameters from the HSL or HSV
+ color models (depending on setting for BrightnessMode) }
+
+unit LVColorPicker;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+uses
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
+ HTMLColors, mbColorConv, mbTrackBarPicker;
+
+type
+ TLVColorPicker = class(TmbHSLVTrackBarPicker)
+ private
+ FHint: array[TBrightnessMode] of string;
+ function ArrowPosFromLum(L: Double): integer;
+ function ArrowPosFromVal(V: Double): integer;
+ function LumFromArrowPos(p: integer): Double;
+ function ValFromArrowPos(p: Integer): Double;
+ function GetHint(AMode: TBrightnessMode): String;
+ procedure SetHint(AMode: TBrightnessMode; AText: String);
+ protected
+ procedure Execute(tbaAction: integer); override;
+ function GetArrowPos: integer; override;
+ function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedValue: integer; override;
+ procedure SetBrightnessMode(AMode: TBrightnessMode); override;
+ procedure SetMaxLum(L: Integer); override;
+ procedure SetMaxVal(V: Integer); override;
+ procedure SetRelLum(L: Double); override;
+ procedure SetRelVal(V: Double); override;
+ procedure SetSelectedColor(c: TColor); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Hue default 0;
+ property Saturation default 0;
+ property Luminance default 255;
+ property Value default 255;
+ property SelectedColor default clWhite;
+ property LHintFormat: String index bmLuminance read GetHint write SetHint;
+ property VHintFormat: String index bmValue read GetHint write SetHint;
+ end;
+
+implementation
+
+uses
+ mbUtils;
+
+{ TLVColorPicker }
+
+constructor TLVColorPicker.Create(AOwner: TComponent);
+begin
+ inherited;
+ case BrightnessMode of
+ bmLuminance : FGradientWidth := FMaxLum + 1;
+ bmValue : FGradientWidth := FMaxVal + 1;
+ end;
+ FGradientHeight := 1;
+ FHue := 0;
+ FSat := 0;
+ FLum := 1;
+ FVal := 1;
+ FHint[bmLuminance] := 'Luminance: %lum (selected)';
+ FHint[bmValue] := 'Value: %value (selected)';
+end;
+
+function TLVColorPicker.ArrowPosFromLum(L: Double): integer;
+var
+ a: integer;
+begin
+ if Layout = lyHorizontal then
+ begin
+ a := Round((Width - 12) * L);
+ if a > Width - FLimit then a := Width - FLimit;
+ end
+ else
+ begin
+ a := Round((Height - 12) * (1.0 - L));
+ if a > Height - FLimit then a := Height - FLimit;
+ end;
+ if a < 0 then a := 0;
+ Result := a;
+end;
+
+function TLVColorPicker.ArrowPosFromVal(V: Double): integer;
+var
+ a: integer;
+begin
+ if Layout = lyHorizontal then
+ begin
+ a := Round((Width - 12) * V);
+ if a > Width - FLimit then a := Width - FLimit;
+ end
+ else
+ begin
+ a := Round((Height - 12) * (1.0 - V));
+ if a > Height - FLimit then a := Height - FLimit;
+ end;
+ if a < 0 then a := 0;
+ Result := a;
+end;
+
+procedure TLVColorPicker.Execute(tbaAction: integer);
+var
+ dLum, dVal: Double;
+begin
+ case BrightnessMode of
+ bmLuminance:
+ begin
+ if FMaxLum = 0 then dLum := 0 else dLum := Increment / FMaxLum;
+ case tbaAction of
+ TBA_Resize:
+ SetRelLum(FLum);
+ TBA_MouseMove:
+ SetRelLum(LumFromArrowPos(FArrowPos));
+ TBA_MouseDown:
+ SetRelLum(LumFromArrowPos(FArrowPos));
+ TBA_MouseUp:
+ SetRelLum(LumFromArrowPos(FArrowPos));
+ TBA_WheelUp:
+ SetRelLum(FLum + dLum);
+ TBA_WheelDown:
+ SetRelLum(FLum - dLum);
+ TBA_VKRight:
+ SetRelLum(FLum + dLum);
+ TBA_VKCtrlRight:
+ SetRelLum(1.0);
+ TBA_VKLeft:
+ SetRelLum(FLum - dLum);
+ TBA_VKCtrlLeft:
+ SetRelLum(0.0);
+ TBA_VKUp:
+ SetRelLum(FLum + dLum);
+ TBA_VKCtrlUp:
+ SetRelLum(1.0);
+ TBA_VKDown:
+ SetRelLum(FLum - dLum);
+ TBA_VKCtrlDown:
+ SetRelLum(0);
+ else
+ inherited;
+ end;
+ end;
+
+ bmValue:
+ begin
+ if FMaxVal = 0 then dVal := 0 else dVal := Increment / FMaxVal;
+ case tbaAction of
+ TBA_Resize:
+ SetRelVal(FVal);
+ TBA_MouseMove:
+ SetRelVal(ValFromArrowPos(FArrowPos));
+ TBA_MouseDown:
+ SetRelVal(ValFromArrowPos(FArrowPos));
+ TBA_MouseUp:
+ SetRelVal(ValFromArrowPos(FArrowPos));
+ TBA_WheelUp:
+ SetRelVal(FVal + dVal);
+ TBA_WheelDown:
+ SetRelVal(FVal - dVal);
+ TBA_VKRight:
+ SetRelval(FVal + dVal);
+ TBA_VKCtrlRight:
+ SetRelVal(1.0);
+ TBA_VKLeft:
+ SetRelval(FVal - dVal);
+ TBA_VKCtrlLeft:
+ SetRelVal(0.0);
+ TBA_VKUp:
+ SetRelVal(FVal + dVal);
+ TBA_VKCtrlUp:
+ SetRelVal(1.0);
+ TBA_VKDown:
+ SetRelval(FVal - dVal);
+ TBA_VKCtrlDown:
+ SetRelVal(0.0);
+ else
+ inherited;
+ end;
+ end;
+ end;
+end;
+
+function TLVColorPicker.GetArrowPos: integer;
+begin
+ case BrightnessMode of
+ bmLuminance:
+ if FMaxLum = 0 then
+ Result := inherited GetArrowPos
+ else
+ Result := ArrowPosFromLum(FLum);
+ bmValue:
+ if FMaxVal = 0 then
+ Result := inherited GetArrowPos
+ else
+ Result := ArrowPosFromVal(FVal);
+ end;
+end;
+
+function TLVColorPicker.GetGradientColor(AValue: Integer): TColor;
+begin
+ Result := HSLVtoColor(FHue, FSat, AValue/FMaxLum, AValue/FMaxVal);
+end;
+
+function TLVColorPicker.GetHint(AMode: TBrightnessMode): String;
+begin
+ Result := FHint[AMode];
+end;
+
+function TLVColorPicker.GetSelectedValue: integer;
+begin
+ case BrightnessMode of
+ bmLuminance : Result := Luminance;
+ bmValue : Result := Value;
+ end;
+end;
+
+function TLVColorPicker.LumFromArrowPos(p: integer): Double;
+var
+ L: Double;
+begin
+ case Layout of
+ lyHorizontal : L := p / (Width - 12);
+ lyVertical : L := 1.0 - p /(Height - 12);
+ end;
+ Clamp(L, 0, 1.0);
+ Result := L;
+end;
+
+procedure TLVColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
+begin
+ inherited;
+ HintFormat := FHint[AMode];
+end;
+
+procedure TLVColorPicker.SetHint(AMode: TBrightnessMode; AText: String);
+begin
+ FHint[AMode] := AText;
+end;
+
+procedure TLVColorPicker.SetMaxLum(L: Integer);
+begin
+ if L = FMaxLum then
+ exit;
+ FMaxLum := L;
+ if BrightnessMode = bmLuminance then begin
+ FGradientWidth := FMaxLum + 1;
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TLVColorPicker.SetMaxVal(V: Integer);
+begin
+ if V = FMaxVal then
+ exit;
+ FMaxVal := V;
+ if BrightnessMode = bmValue then begin
+ FGradientWidth := FMaxVal + 1;
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TLVColorPicker.SetRelLum(L: Double);
+begin
+ Clamp(L, 0, 1.0);
+ if FLum <> L then
+ begin
+ FLum := L;
+ FArrowPos := ArrowPosFromLum(L);
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TLVColorPicker.SetRelVal(V: Double);
+begin
+ Clamp(V, 0, 1.0);
+ if FVal <> V then
+ begin
+ FVal := V;
+ FArrowPos := ArrowPosFromVal(V);
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TLVColorPicker.SetSelectedColor(c: TColor);
+var
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
+ needNewGradient: Boolean;
+begin
+ if WebSafe then
+ c := GetWebSafe(c);
+ if c = GetSelectedColor then
+ exit;
+
+ ColorToHSLV(c, H, S, L, V);
+ needNewGradient := (H <> FHue) or (S <> FSat);
+ FHue := H;
+ FSat := S;
+ case BrightnessMode of
+ bmLuminance : FLum := L;
+ bmValue : FVal := V;
+ end;
+ if needNewGradient then
+ CreateGradient;
+ Invalidate;
+ DoChange;
+end;
+
+function TLVColorPicker.ValFromArrowPos(p: integer): Double;
+var
+ V: Double;
+begin
+ case Layout of
+ lyHorizontal : V := p / (Width - 12);
+ lyVertical : V := 1.0 - p /(Height - 12);
+ end;
+ Clamp(V, 0, 1.0);
+ Result := V;
+end;
+
+end.
diff --git a/components/mbColorLib/MColorPicker.pas b/components/mbColorLib/MColorPicker.pas
index f7d684124..6bcfc9484 100644
--- a/components/mbColorLib/MColorPicker.pas
+++ b/components/mbColorLib/MColorPicker.pas
@@ -14,18 +14,18 @@ type
private
FCyan, FMagenta, FYellow, FBlack: integer;
function ArrowPosFromMagenta(m: integer): integer;
- function GetSelectedColor: TColor;
function MagentaFromArrowPos(p: integer): integer;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
- procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -33,8 +33,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 255;
property Yellow: integer read FYellow write SetYellow default 0;
property Black: integer read FBlack write SetBlack default 0;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
diff --git a/components/mbColorLib/OfficeMoreColorsDialog.lfm b/components/mbColorLib/OfficeMoreColorsDialog.lfm
index 196d2e58b..e6edd3de5 100644
--- a/components/mbColorLib/OfficeMoreColorsDialog.lfm
+++ b/components/mbColorLib/OfficeMoreColorsDialog.lfm
@@ -56,9 +56,10 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
TabIndex = 1
TabOrder = 0
OnChange = PagesChange
+ OnChanging = PagesChanging
object Standard: TTabSheet
Caption = 'Standard'
- ClientHeight = 273
+ ClientHeight = 277
ClientWidth = 243
object Label2: TLabel
Left = 6
@@ -73,11 +74,11 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 0
- Height = 246
- Top = 26
+ Height = 254
+ Top = 22
Width = 240
Anchors = [akTop, akLeft, akRight, akBottom]
- HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
+ HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %hex'
IntensityText = 'Intensity'
TabOrder = 0
Constraints.MinHeight = 85
@@ -173,7 +174,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Caption = '&Sat:'
ParentColor = False
end
- object LLum: TLabel
+ object LLumVal: TLabel
Left = 120
Height = 15
Top = 249
@@ -200,11 +201,12 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 141
Top = 0
Width = 232
- Hue = 180
- Saturation = 227
- SelectedColor = 16315911
+ SelectedColor = 460791
+ Saturation = 241
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l'
+ VPickerHintFormat = 'Value: %value (selected)'
+ MaxLuminance = 255
Align = alClient
TabOrder = 0
OnChange = ColorPickerChange
@@ -218,9 +220,14 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 124
Top = 0
Width = 136
+ SelectedColor = 14803455
+ Saturation = 30
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
- SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
+ SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
+ SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
+ MaxLuminance = 255
+ MaxSaturation = 255
ParentShowHint = False
Anchors = [akTop, akLeft, akBottom]
TabOrder = 0
@@ -242,13 +249,16 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Top = 0
Width = 232
ParentColor = False
+ SelectedColor = clWhite
+ Saturation = 0
Luminance = 240
HPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
+ MaxSaturation = 255
+ MaxLuminance = 255
ParentShowHint = False
Align = alClient
TabOrder = 0
- Color = clMenuHighlight
OnChange = ColorPickerChange
end
end
@@ -260,7 +270,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 0
Width = 218
- HintFormat = 'Red: %value (selected)'
+ SelectedColor = 8026879
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@@ -268,7 +278,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Green = 122
Blue = 122
- SelectedColor = 8026879
+ HintFormat = 'Red: %value (selected)'
end
object GTrackbar: TGColorPicker
AnchorSideRight.Control = nbRGB
@@ -277,9 +287,9 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 40
Width = 216
+ SelectedColor = 8060794
BevelInner = bvLowered
BevelOuter = bvRaised
- HintFormat = 'Green: %value (selected)'
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@@ -287,7 +297,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Red = 122
Blue = 122
- SelectedColor = 8060794
+ HintFormat = 'Green: %value (selected)'
end
object BTrackbar: TBColorPicker
AnchorSideRight.Control = nbRGB
@@ -296,7 +306,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 32
Top = 80
Width = 216
- HintFormat = 'Blue: %value (selected)'
+ SelectedColor = 16743034
Layout = lyHorizontal
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akRight]
@@ -304,7 +314,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
OnChange = ColorPickerChange
Green = 122
Red = 122
- SelectedColor = 16743034
+ HintFormat = 'Blue: %value (selected)'
end
object Label6: TLabel
AnchorSideTop.Control = RTrackbar
diff --git a/components/mbColorLib/OfficeMoreColorsDialog.pas b/components/mbColorLib/OfficeMoreColorsDialog.pas
index 1c19a606d..0ce558cbd 100644
--- a/components/mbColorLib/OfficeMoreColorsDialog.pas
+++ b/components/mbColorLib/OfficeMoreColorsDialog.pas
@@ -5,7 +5,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, ComCtrls,
- HexaColorPicker, HSLColorPicker, RGBHSLUtils, mbColorPreview,
+ HexaColorPicker, HSLColorPicker, mbColorConv, mbColorPreview,
{$IFDEF mbXP_Lib}mbXPSpinEdit, mbXPSizeGrip,{$ELSE} Spin,{$ENDIF}
HTMLColors, SLHColorPicker, HSLRingPicker, RColorPicker, GColorPicker,
BColorPicker;
@@ -22,7 +22,7 @@ type
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
- LLum: TLabel;
+ LLumVal: TLabel;
LSat: TLabel;
LHue: TLabel;
nbRGB: TPage;
@@ -51,49 +51,66 @@ type
NewSwatch: TmbColorPreview;
OldSwatch: TmbColorPreview;
procedure cbColorDisplayChange(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure HSLChange(Sender: TObject);
- procedure ERedChange(Sender: TObject);
- procedure EGreenChange(Sender: TObject);
+ procedure ColorPickerChange(Sender: TObject);
procedure EBlueChange(Sender: TObject);
+ procedure EGreenChange(Sender: TObject);
procedure EHueChange(Sender: TObject);
+ procedure ELumValChange(Sender: TObject);
+ procedure ERedChange(Sender: TObject);
procedure ESatChange(Sender: TObject);
- procedure ELumChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormResize(Sender: TObject);
+ procedure FormShow(Sender: TObject);
function GetHint(c: TColor): string;
procedure HexaChange(Sender: TObject);
+ procedure HSLChange(Sender: TObject);
procedure HSLRingChange(Sender: TObject);
procedure NewSwatchColorChange(Sender: TObject);
procedure OldSwatchColorChange(Sender: TObject);
procedure PagesChange(Sender: TObject);
- procedure ColorPickerChange(Sender: TObject);
+ procedure PagesChanging(Sender: TObject; var {%H-}AllowChange: Boolean);
procedure SLHChange(Sender: TObject);
private
{$IFDEF mbXP_Lib}
ERed, EGreen, EBlue: TmbXPSpinEdit;
- EHue, ESat, ELum: TmbXPSpinEdit;
+ EHue, ESat, ELumVal: TmbXPSpinEdit;
grip: TmbXPSizeGrip;
{$ELSE}
ERed, EGreen, EBlue: TSpinEdit;
- EHue, ESat, ELum: TSpinEdit;
+ EHue, ESat, ELumVal: TSpinEdit;
{$ENDIF}
FMaxHue: Integer;
FMaxSat: Integer;
FMaxLum: Integer;
+ FMaxVal: Integer;
+ FSelectedColor: TColor;
+ FBrightnessMode: TBrightnessMode;
FLockChange: Integer;
+ function GetPickerIndex: Integer;
+ function GetSelectedColor: TColor;
function GetShowHint: Boolean;
procedure SetAllCustom(c: TColor);
procedure SetAllToSel(c: TColor);
+ procedure SetBrightnessMode(AMode: TBrightnessMode);
+ procedure SetMaxHue(H: Integer);
+ procedure SetMaxLum(L: Integer);
+ procedure SetMaxSat(S: Integer);
+ procedure SetMaxVal(V: Integer);
+ procedure SetPickerIndex(AValue: Integer);
+ procedure SetSelectedColor(c: TColor);
procedure SetShowHint(AValue: boolean);
protected
+ procedure BeginUpdate;
procedure CreateParams(var Params: TCreateParams); override;
-// procedure CreateWnd; override;
+ procedure EndUpdate;
public
- property MaxHue: Integer read FMaxHue write FMaxHue;
- property MaxSaturation: Integer read FMaxSat write FMaxSat;
- property MaxLuminance: Integer read FMaxLum write FMaxLum;
+ property PickerIndex: Integer read GetPickerIndex write SetPickerIndex;
+ property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
+ property MaxHue: Integer read FMaxHue write SetMaxHue;
+ property MaxSaturation: Integer read FMaxSat write SetMaxSat;
+ property MaxLuminance: Integer read FMaxLum write SetMaxLum;
+ property MaxValue: Integer read FMaxVal write SetMaxVal;
published
property ShowHint: Boolean read GetShowHint write SetShowHint;
end;
@@ -105,8 +122,16 @@ implementation
{$R *.lfm}
+procedure TOfficeMoreColorsWin.BeginUpdate;
+begin
+ inc(FLockChange);
+end;
+
procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject);
begin
+ if FLockChange > 0 then
+ exit;
+
if Sender = HSL then
SetAllCustom(HSL.SelectedColor);
if Sender = HSLRing then
@@ -183,27 +208,42 @@ begin
try
HSL.Hue := EHue.Value;
SLH.Hue := EHue.Value;
- NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
+ case FBrightnessMode of
+ bmLuminance:
+ NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum);
+ bmValue:
+ NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal);
+ end;
finally
dec(FLockChange);
end;
end;
end;
-procedure TOfficeMoreColorsWin.ELumChange(Sender: TObject);
+procedure TOfficeMoreColorsWin.ELumValChange(Sender: TObject);
begin
- if (ELum.Text <> '') and ELum.Focused and (FLockChange = 0) then
+ if (ELumVal.Text <> '') and ELumVal.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
- HSL.Luminance := ELum.Value;
- NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
+ HSL.Luminance := ELumVal.Value;
+ case FBrightnessMode of
+ bmLuminance:
+ NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxLum);
+ bmValue:
+ NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumVal.Value/FMaxVal);
+ end;
finally
dec(FLockChange);
end;
end;
end;
+procedure TOfficeMoreColorsWin.EndUpdate;
+begin
+ dec(FLockChange);
+end;
+
procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject);
begin
if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then
@@ -227,7 +267,12 @@ begin
try
HSL.Saturation := ESat.Value;
SLH.Saturation := ESat.Value;
- NewSwatch.Color := HSLToRGB(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELum.Value/FMaxLum);
+ case FBrightnessMode of
+ bmLuminance:
+ NewSwatch.Color := HSLToColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxLum);
+ bmValue:
+ NewSwatch.Color := HSVtoColor(EHue.Value/FMaxHue, ESat.Value/FMaxSat, ELumval.Value/FMaxVal);
+ end;
finally
dec(FLockChange);
end;
@@ -236,21 +281,27 @@ end;
procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject);
begin
- FMaxHue := 359;
- FMaxSat := 240;
- FMaxLum := 240;
+ FBrightnessMode := bmLuminance;
+
+ FMaxHue := 360;
+ FMaxSat := 255;
+ FMaxLum := 255;
+ FMaxVal := 255;
HSL.MaxHue := FMaxHue;
HSL.MaxSaturation := FMaxSat;
HSL.MaxLuminance := FMaxLum;
+ HSL.BrightnessMode := FBrightnessMode;
HSLRing.MaxHue := FMaxHue;
HSLRing.MaxSaturation := FMaxSat;
HSLRing.MaxLuminance := FMaxLum;
+ HSLRing.BrightnessMode := FBrightnessMode;
SLH.MaxHue := FMaxHue;
SLH.MaxSaturation := FMaxSat;
SLH.MaxLuminance := FMaxLum;
+ SLH.BrightnessMode := FBrightnessMode;
{$IFDEF mbXP_Lib}
ERed := TmbXPSpinEdit.CreateParented(Custom.Handle);
@@ -263,7 +314,7 @@ begin
EBlue := TSpinEdit.CreateParented(Custom.Handle);
EHue := TSpinEdit.CreateParented(Custom.Handle);
ESat := TSpinEdit.CreateParented(Custom.Handle);
- ELum := TSpinEdit.CreateParented(Custom.Handle);
+ ELumVal := TSpinEdit.CreateParented(Custom.Handle);
{$ENDIF}
with ERed do
begin
@@ -340,9 +391,9 @@ begin
OnChange := @ESatChange;
// TabOrder := EHue.TabOrder + 1;
end;
- with ELum do
+ with ELumVal do
begin
- Name := 'ELum';
+ Name := 'ELumVal';
Width := 47;
Height := 22;
Left := cbColorDisplay.Left + cbColorDisplay.Width - Width;
@@ -352,7 +403,7 @@ begin
MaxValue := FMaxLum;
MinValue := 0;
Value := 0;
- OnChange := @ELumChange;
+ OnChange := @ELumValChange;
// TabOrder := ESat.TabOrder + 1;
end;
Custom.InsertControl(ERed);
@@ -360,7 +411,7 @@ begin
Custom.InsertControl(EBlue);
Custom.InsertControl(EHue);
Custom.InsertControl(ESat);
- Custom.InsertControl(ELum);
+ Custom.InsertControl(ELumVal);
{$IFDEF mbXP_Lib}
with grip do
@@ -375,7 +426,7 @@ begin
InsertControl(grip);
{$ENDIF}
- OKBtn.TabOrder := ELum.TabOrder + 1;
+ OKBtn.TabOrder := ELumVal.TabOrder + 1;
CancelBtn.TabOrder := OKBtn.TabOrder + 1;
end;
@@ -415,6 +466,32 @@ begin
]);
end;
+function TOfficeMoreColorsWin.GetPickerIndex: Integer;
+begin
+ Result := PickerNotebook.PageIndex + 1;
+ if Pages.PageIndex = 0 then
+ Result := -Result;
+end;
+
+procedure TOfficeMoreColorsWin.SetPickerIndex(AValue: Integer);
+begin
+ if AValue = 0 then begin
+ Pages.PageIndex := 0;
+ PickerNotebook.PageIndex := 0;
+ end else
+ begin
+ PickerNotebook.PageIndex := abs(AValue) - 1;
+ if AValue > 0 then
+ Pages.PageIndex := 1 else
+ Pages.PageIndex := 0;
+ end;
+end;
+
+function TOfficeMoreColorsWin.GetSelectedColor: TColor;
+begin
+ Result := NewSwatch.Color;
+end;
+
function TOfficeMoreColorsWin.GetShowHint: Boolean;
begin
Result := inherited ShowHint;
@@ -436,13 +513,14 @@ begin
end;
procedure TOfficeMoreColorsWin.NewSwatchColorChange(Sender: TObject);
-var
- r,g,b: Integer;
- h,s,l: Integer;
begin
NewSwatch.Hint := GetHint(NewSwatch.Color);
+
+ exit;
+
+
if (ERed = nil) or (EBlue = nil) or (EGreen = nil) or
- (EHue = nil) or (ESat = nil) or (ELum = nil)
+ (EHue = nil) or (ESat = nil) or (ELumVal = nil)
then
exit;
@@ -452,33 +530,57 @@ end;
procedure TOfficeMoreColorsWin.OldSwatchColorChange(Sender: TObject);
begin
OldSwatch.Hint := GetHint(OldSwatch.Color);
- SetAllToSel(OldSwatch.Color);
+
+
+
+ //SetAllToSel(OldSwatch.Color);
end;
procedure TOfficeMoreColorsWin.PagesChange(Sender: TObject);
begin
- SetAllToSel(NewSwatch.Color);
+ SetAllToSel(FSelectedColor); //NewSwatch.Color);
+end;
+
+procedure TOfficeMoreColorsWin.PagesChanging(Sender: TObject;
+ var AllowChange: Boolean);
+begin
+ FSelectedColor := NewSwatch.Color;
+ {
+ case Pages.PageIndex of
+ 0: FSelectedColor := Hexa.SelectedColor;
+ 1: case PickerNotebook.PageIndex of
+ 0: FSelectedColor := HSL.SelectedColor;
+ 1: FSelectedColor := HSLRing.SelectedColor;
+ 2: FSelectedColor := SLH.SelectedColor;
+ 3: FSelectedColor := RgbToColor(RTrackbar.Red, GTrackbar.Green, BTrackbar.Blue);
+ end;
+ end;
+ }
end;
procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor);
var
r, g, b: Integer;
- H, S, L: Double;
-// h, s, l: Integer;
+ H, S, L, V: Double;
begin
if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or
- (EHue = nil) or (ESat = nil) or (ELum = nil) or
+ (EHue = nil) or (ESat = nil) or (ELumVal = nil) or
(PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil)
+ or (FLockChange > 0)
then
exit;
+ BeginUpdate;
+
NewSwatch.Color := c;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
- RGBToHSL(c, H, S, L);
-// RGBtoHSLRange(c, h, s, l);
+ case FBrightnessMode of
+ bmLuminance : ColorToHSL(c, H, S, L);
+ bmValue : ColortoHSV(c, H, S, V);
+ end;
if PickerNotebook.ActivePage = nbHSL.Name then
HSL.SelectedColor := c
@@ -503,13 +605,17 @@ begin
EBlue.Value := b;
EHue.Value := H * HSL.MaxHue;
ESat.Value := S * HSL.MaxSaturation;
- ELum.Value := L * HSL.MaxLuminance;
+ case FBrightnessMode of
+ bmLuminance: ELumVal.Value := L * HSL.MaxLuminance;
+ bmValue : ELumVal.Value := V * HSL.MaxValue;
+ end;
+
+ EndUpdate;
end;
procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor);
-var
- h, s, l: Integer;
begin
+ //inc(FLockChange);
case Pages.ActivePageIndex of
// Standard Page
0: Hexa.SelectedColor := c;
@@ -517,6 +623,71 @@ begin
1: SetAllCustom(c);
end;
NewSwatch.Color := c;
+ //dec(FLockChange);
+end;
+
+procedure TOfficeMoreColorsWin.SetBrightnessMode(AMode: TBrightnessMode);
+begin
+ FBrightnessMode := AMode;
+ case AMode of
+ bmLuminance: LLumVal.Caption := 'Lum:';
+ bmValue : LLumval.Caption := 'Val:';
+ end;
+end;
+
+procedure TOfficeMoreColorsWin.SetMaxHue(H: Integer);
+var
+ hh: Double;
+begin
+ inc(FLockChange);
+ hh := EHue.Value / FMaxHue;
+ FMaxHue := H;
+ EHue.MaxValue := H;
+ EHue.Value := round(hh * FMaxHue);
+ dec(FLockChange);
+end;
+
+procedure TOfficeMoreColorsWin.SetMaxLum(L: Integer);
+var
+ ll: Double;
+begin
+ inc(FLockChange);
+ ll := ELumVal.Value / FMaxLum;
+ FMaxLum := L;
+ ELumVal.MaxValue := L;
+ ELumVal.Value := round(ll * FMaxLum);
+ dec(FLockChange);
+end;
+
+procedure TOfficeMoreColorsWin.SetMaxSat(S: Integer);
+var
+ ss: Double;
+begin
+ inc(FLockChange);
+ ss := ESat.Value / FMaxSat;
+ FMaxSat := S;
+ ESat.MaxValue := S;
+ ESat.Value := round(ss * FMaxSat);
+ dec(FLockChange);
+end;
+
+procedure TOfficeMoreColorsWin.SetMaxVal(V: Integer);
+var
+ vv: Double;
+begin
+ inc(FLockChange);
+ vv := ELumVal.Value / FMaxVal;
+ FMaxVal := V;
+ ELumVal.MaxValue := V;
+ ELumVal.Value := round(vv * FMaxVal);
+ dec(FLockChange);
+end;
+
+procedure TOfficeMoreColorsWin.SetSelectedColor(c: TColor);
+begin
+ FSelectedColor := c;
+ OldSwatch.Color := c;
+ SetAllToSel(FSelectedColor);
end;
procedure TOfficeMoreColorsWin.SetShowHint(AValue: Boolean);
@@ -526,6 +697,9 @@ begin
HSL.ShowHint := AValue;
HSLRing.ShowHint := AValue;
SLH.ShowHint := AValue;
+ RTrackbar.ShowHint := AValue;
+ GTrackbar.ShowHint := AValue;
+ BTrackbar.ShowHint := AValue;
end;
procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject);
diff --git a/components/mbColorLib/PalUtils.pas b/components/mbColorLib/PalUtils.pas
index ceaa27c38..701a6fffa 100644
--- a/components/mbColorLib/PalUtils.pas
+++ b/components/mbColorLib/PalUtils.pas
@@ -50,13 +50,13 @@ function ReadJASCPal(PalFile: TFileName): string;
//saves a string list to a JASC .pal file
procedure SaveJASCPal(pal: TStrings; FileName: TFileName);
-
+(*
//reads Photoshop .aco file into an Aco record
function ReadPhotoshopAco(PalFile: TFileName): AcoColors;
//reads Photoshop .act file
function ReadPhotoshopAct(PalFile: TFileName): string;
-
+ *)
implementation
@@ -87,7 +87,7 @@ function FormatHint(fmt: string; c: TColor): string;
var
h: string;
begin
- h := AnsiReplaceText(fmt, '%hex', ColorToHex(c));
+ h := AnsiReplaceText(fmt, '%hex', '#' + ColorToHex(c));
h := AnsiReplaceText(h, '%cieL', IntToStr(Round(GetCIElValue(c))));
h := AnsiReplaceText(h, '%cieA', IntToStr(Round(GetCIEaValue(c))));
h := AnsiReplaceText(h, '%cieB', IntToStr(Round(GetCIEbValue(c))));
@@ -579,7 +579,7 @@ begin
s[i] := WideChar(w);
end;
end;
-
+ (*
function GetAcoColor(space,w,x,y,z: word): TColor;
begin
case space of
@@ -711,5 +711,5 @@ begin
end;
CloseFile(f);
end;
-
+ *)
end.
diff --git a/components/mbColorLib/RAxisColorPicker.pas b/components/mbColorLib/RAxisColorPicker.pas
index eb929fa0b..08ed5c4e8 100644
--- a/components/mbColorLib/RAxisColorPicker.pas
+++ b/components/mbColorLib/RAxisColorPicker.pas
@@ -157,7 +157,6 @@ end;
procedure TRAxisColorPicker.Resize;
begin
- FManual := false;
mx := Round(FB * Width / 255);
my := Round((255 - FG) * Height / 255);
inherited;
@@ -231,7 +230,6 @@ begin
FG := g;
FB := b;
FSelected := c;
- FManual := false;
mx := Round(FB * Width / 255); // BLUE on x
my := Round((255 - FG) * Height / 255); // GREEN on y
if needNewGradient then
diff --git a/components/mbColorLib/RColorPicker.pas b/components/mbColorLib/RColorPicker.pas
index 17a567496..f7c2498c2 100644
--- a/components/mbColorLib/RColorPicker.pas
+++ b/components/mbColorLib/RColorPicker.pas
@@ -6,7 +6,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
- HTMLColors, Scanlines, mbTrackBarPicker;
+ HTMLColors, mbTrackBarPicker;
type
@@ -16,25 +16,26 @@ type
private
FRed, FGreen, FBlue: integer;
function ArrowPosFromRed(r: integer): integer;
- function GetSelectedColor: TColor;
function RedFromArrowPos(p: integer): integer;
procedure SetBlue(b: integer);
procedure SetGreen(g: integer);
procedure SetRed(r: integer);
- procedure SetSelectedColor(c: TColor);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property Red: integer read FRed write SetRed default 255;
property Green: integer read FGreen write SetGreen default 128;
property Blue: integer read FBlue write SetBlue default 128;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
diff --git a/components/mbColorLib/RGBCIEUtils.pas b/components/mbColorLib/RGBCIEUtils.pas
index 42c739ff5..499d4f868 100644
--- a/components/mbColorLib/RGBCIEUtils.pas
+++ b/components/mbColorLib/RGBCIEUtils.pas
@@ -243,7 +243,8 @@ end;
procedure RGBToLCH(clr: TColor; var l, c, h: double);
var
- a, b: double;
+ a: Double = 0;
+ b: Double = 0;
begin
RGBToLab(clr, l, a, b);
LabToLCH(l, a, b, l, c, h);
@@ -251,7 +252,9 @@ end;
function LCHToRGB(l, c, h: double): TColor;
var
- lum, a, b: double;
+ lum: Double = 0;
+ a: Double = 0;
+ b: double = 0;
begin
LCHToLab(l, c, h, lum, a, b);
Result := LabToRGB(lum, a, b);
@@ -283,36 +286,38 @@ end;
function GetCIELValue(c: TColor): double;
var
- d: real;
+ d: Double = 0;
begin
- XYZToLab(RGBToXYZ(c), Result, d, d);
+ XYZToLab(RGBToXYZ(c), Result{%H-}, d, d);
end;
function GetCIEAValue(c: TColor): double;
var
- d: double;
+ d: double = 0;
begin
- XYZToLab(RGBToXYZ(c), d, Result, d);
+ XYZToLab(RGBToXYZ(c), d, Result{%H-}, d);
end;
function GetCIEBValue(c: TColor): double;
var
- d: double;
+ d: double = 0;
begin
- XYZToLab(RGBToXYZ(c), d, d, Result);
+ XYZToLab(RGBToXYZ(c), d, d, Result{%H-});
end;
function GetCIECValue(c: TColor): double;
var
- d: double;
+ d: double = 0;
begin
+ Result := 0.0;
RGBToLCH(c, d, Result, d);
end;
function GetCIEHValue(c: TColor): double;
var
- d: double;
+ d: double = 0;
begin
+ Result := 0.0;
RGBToLCH(c, d, d, Result);
end;
diff --git a/components/mbColorLib/RGBHSLUtils.pas b/components/mbColorLib/RGBHSLUtils.pas
index 7e8abfbd1..63574921e 100644
--- a/components/mbColorLib/RGBHSLUtils.pas
+++ b/components/mbColorLib/RGBHSLUtils.pas
@@ -14,13 +14,13 @@ var //set these variables to your needs, e.g. 360, 255, 255
MaxSat: integer = 240;
MaxLum: integer = 240;
-function HSLtoRGB(H, S, L: double): TColor;
+{function HSLtoRGB(H, S, L: double): TColor;}
function HSLRangeToRGB(H, S, L: integer): TColor;
-procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
+{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 RGBtoHSL(RGB: TColor; out H, S, L: Double); }
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
function GetHValue(AColor: TColor): integer;
@@ -36,7 +36,7 @@ implementation
uses
mbUtils;
-
+ (*
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function RGBMaxValue(r, g, b: Double): Double;
@@ -81,7 +81,7 @@ begin
if H < 0 then H := H + 360;
H := H / 360;
end;
-end;
+end; *)
function HSLtoColor(H, S, L: Double): TColor;
const
@@ -133,9 +133,6 @@ var
begin
if Hue > 10 then
Hue := Hue + 1;
-
-
-
if Hue < 0 then
Hue := Hue + 1
else if Hue > 1 then
@@ -224,9 +221,6 @@ procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
var
R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
- H := h1;
- S := s1;
- L := l1;
R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255;
diff --git a/components/mbColorLib/RGBHSVUtils.pas b/components/mbColorLib/RGBHSVUtils.pas
index cb243827f..902f77545 100644
--- a/components/mbColorLib/RGBHSVUtils.pas
+++ b/components/mbColorLib/RGBHSVUtils.pas
@@ -11,11 +11,11 @@ uses
Scanlines;
{ The next four procedures assume H, S, V to be in the range 0..1 }
-procedure ColorToHSV(c: TColor; out H, S, V: Double);
-procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
+//procedure ColorToHSV(c: TColor; out H, S, V: Double);
+//procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
-function HSVtoColor(H, S, V: Double): TColor;
-procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
+//function HSVtoColor(H, S, V: Double): TColor;
+//procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
{ These next procedure assume H to be in the range 0..360
and S, V in the range 0..255 }
@@ -117,8 +117,6 @@ procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer);
var
Delta, Min, H1, S1: double;
begin
- h1 := h;
- s1 := s;
Min := MinIntValue([R, G, B]);
V := MaxIntValue([R, G, B]);
Delta := V - Min;
diff --git a/components/mbColorLib/SColorPicker.pas b/components/mbColorLib/SColorPicker.pas
index 0488a49fe..c2f0a38fe 100644
--- a/components/mbColorLib/SColorPicker.pas
+++ b/components/mbColorLib/SColorPicker.pas
@@ -7,43 +7,31 @@ unit SColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Forms,
- RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
+ mbColorConv, mbTrackBarPicker, HTMLColors;
type
- TSColorPicker = class(TmbTrackBarPicker)
+ TSColorPicker = class(TmbHSLVTrackBarPicker)
private
- FVal, FHue, FSat: Double;
- FMaxVal, FMaxHue, FMaxSat: Integer;
- function ArrowPosFromSat(s: integer): integer;
- function GetHue: Integer;
- function GetSat: Integer;
- function GetSelectedColor: TColor;
- function GetVal: Integer;
- function SatFromArrowPos(p: integer): integer;
- procedure SetHue(h: integer);
- procedure SetMaxHue(h: Integer);
- procedure SetMaxSat(s: Integer);
- procedure SetMaxVal(v: Integer);
- procedure SetSat(s: integer);
- procedure SetValue(v: integer);
- procedure SetSelectedColor(c: TColor);
+ function ArrowPosFromSat(s: Double): integer;
+ function SatFromArrowPos(p: integer): Double;
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetMaxSat(S: Integer); override;
+ procedure SetRelSat(S: Double); override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
- property Hue: integer read GetHue write SetHue;
- property Saturation: integer read GetSat write SetSat;
- property Value: integer read GetVal write SetValue;
- property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
- property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
- property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property Hue default 0;
+ property Saturation default 255;
+ property Luminance default 127;
+ property Value default 255;
+ property SelectedColor default clRed;
+ property HintFormat;
end;
@@ -57,29 +45,27 @@ uses
constructor TSColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FMaxHue := 359;
- FMaxSat := 255;
- FMaxVal := 255;
FGradientWidth := FMaxSat + 1;
FGradientHeight := 1;
FHue := 0;
+ FLum := 0.5;
FVal := 1.0;
- SetSat(FMaxSat);
+ Saturation := 255;
HintFormat := 'Saturation: %value (selected)';
end;
-function TSColorPicker.ArrowPosFromSat(s: integer): integer;
+function TSColorPicker.ArrowPosFromSat(s: Double): integer;
var
a: integer;
begin
if Layout = lyHorizontal then
begin
- a := Round(s / FMaxSat * (Width - 12));
+ a := Round(s * (Width - 12));
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
- a := Round((FMaxSat - s) / FMaxSat * (Height - 12));
+ a := Round((1.0 - s) * (Height - 12));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@@ -87,36 +73,39 @@ begin
end;
procedure TSColorPicker.Execute(tbaAction: integer);
+var
+ dSat: Double;
begin
+ if FMaxSat = 0 then dSat := 0 else dSat := Increment / FMaxSat;
case tbaAction of
TBA_Resize:
- SetSat(GetSat());
+ SetRelSat(FSat);
TBA_MouseMove:
- SetSat(SatFromArrowPos(FArrowPos));
+ SetRelSat(SatFromArrowPos(FArrowPos));
TBA_MouseDown:
- SetSat(SatFromArrowPos(FArrowPos));
+ SetRelSat(SatFromArrowPos(FArrowPos));
TBA_MouseUp:
- SetSat(SatFromArrowPos(FArrowPos));
+ SetRelSat(SatFromArrowPos(FArrowPos));
TBA_WheelUp:
- SetSat(GetSat() + Increment);
+ SetRelSat(FSat + dSat);
TBA_WheelDown:
- SetSat(GetSat() - Increment);
+ SetRelSat(FSat - dSat);
TBA_VKLeft:
- SetSat(GetSat() - Increment);
+ SetRelSat(FSat - dSat);
TBA_VKCtrlLeft:
- SetSat(0);
+ SetRelSat(0.0);
TBA_VKRight:
- SetSat(GetSat() + Increment);
+ SetRelSat(FSat + dSat);
TBA_VKCtrlRight:
- SetSat(FMaxSat);
+ SetRelSat(1.0);
TBA_VKUp:
- SetSat(GetSat() + Increment);
+ SetRelSat(FSat + dSat);
TBA_VKCtrlUp:
- SetSat(FMaxSat);
+ SetRelSat(1.0);
TBA_VKDown:
- SetSat(GetSat() - Increment);
+ SetRelSat(FSat - dSat);
TBA_VKCtrlDown:
- SetSat(0);
+ SetRelSat(0.0);
else
inherited;
end;
@@ -127,103 +116,49 @@ begin
if FMaxSat = 0 then
Result := inherited GetArrowPos
else
- Result := ArrowPosFromSat(GetSat());
+ Result := ArrowPosFromSat(FSat);
end;
function TSColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
- Result := HSVtoColor(FHue, AValue/FMaxSat, FVal);
-end;
-
-function TSColorPicker.GetHue: Integer;
-begin
- Result := round(FHue * FMaxHue);
-end;
-
-function TSColorPicker.GetSat: Integer;
-begin
- Result := round(FSat * FMaxSat);
-end;
-
-function TSColorPicker.GetSelectedColor: TColor;
-begin
- Result := HSVToColor(FHue, FSat, FVal);
- if WebSafe then
- Result := GetWebSafe(Result);
+ Result := HSLVtoColor(FHue, AValue/FMaxSat, FLum, FVal);
end;
function TSColorPicker.GetSelectedValue: integer;
begin
- Result := GetSat();
+ Result := Saturation;
end;
-function TSColorPicker.GetVal: Integer;
-begin
- Result := round(FVal * FMaxVal);
-end;
-
-function TSColorPicker.SatFromArrowPos(p: integer): integer;
+function TSColorPicker.SatFromArrowPos(p: integer): Double;
var
- s: integer;
+ s: Double;
begin
case Layout of
- lyHorizontal: s := Round(p / (Width - 12) * FMaxSat);
- lyVertical : s := Round(FMaxSat - p / (Height - 12) * FMaxSat);
+ lyHorizontal: s := p / (Width - 12);
+ lyVertical : s := 1.0 - p / (Height - 12);
end;
- Clamp(s, 0, FMaxSat);
+ Clamp(s, 0, 1.0);
Result := s;
end;
-procedure TSColorPicker.SetMaxHue(h: Integer);
+procedure TSColorPicker.SetMaxSat(S: Integer);
begin
- if h = FMaxHue then
+ if S = FMaxSat then
exit;
- FMaxHue := h;
- CreateGradient;
- //if FChange and Assigned(OnChange) then OnChange(Self);
- Invalidate;
-end;
-
-procedure TSColorPicker.SetMaxSat(s: Integer);
-begin
- if s = FMaxSat then
- exit;
- FMaxSat := s;
+ FMaxSat := S;
FGradientWidth := FMaxSat + 1;
CreateGradient;
- //if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
+ DoChange;
end;
-procedure TSColorPicker.SetMaxVal(v: Integer);
+procedure TSColorPicker.SetRelSat(S: Double);
begin
- if v = FMaxVal then
- exit;
- FMaxVal := v;
- CreateGradient;
- //if FChange and Assigned(OnChange) then OnChange(Self);
- Invalidate;
-end;
-
-procedure TSColorPicker.SetHue(h: integer);
-begin
- Clamp(h, 0, FMaxHue);
- if GetHue() <> h then
+ Clamp(S, 0, 1.0);
+ if FSat <> S then
begin
- FHue := h / FMaxHue;
- CreateGradient;
- Invalidate;
- DoChange;
- end;
-end;
-
-procedure TSColorPicker.SetSat(s: integer);
-begin
- Clamp(s, 0, FMaxSat);
- if GetSat() <> s then
- begin
- FSat := s / FMaxSat;
- FArrowPos := ArrowPosFromSat(s);
+ FSat := S;
+ FArrowPos := ArrowPosFromSat(S);
Invalidate;
DoChange;
end;
@@ -231,7 +166,10 @@ end;
procedure TSColorPicker.SetSelectedColor(c: TColor);
var
- h, s, v: integer;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@@ -239,27 +177,25 @@ begin
if c = GetSelectedColor then
exit;
- RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
- needNewGradient := (h <> FHue) or (v <> FVal);
- FHue := h;
- FSat := s;
- FVal := v;
+ ColorToHSLV(c, H,S,L,V);
+ case BrightnessMode of
+ bmLuminance:
+ begin
+ needNewGradient := (H <> FHue) or (L <> FLum);
+ FLum := L;
+ end;
+ bmValue:
+ begin
+ needNewGradient := (H <> FHue) or (V <> FVal);
+ FVal := V;
+ end;
+ end;
+ FHue := H;
+ FSat := S;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
-procedure TSColorPicker.SetValue(v: integer);
-begin
- Clamp(v, 0, FMaxVal);
- if GetVal() <> v then
- begin
- FVal := v / FMaxVal;
- CreateGradient;
- Invalidate;
- DoChange;
- end;
-end;
-
end.
diff --git a/components/mbColorLib/SLColorPicker.pas b/components/mbColorLib/SLColorPicker.pas
index 175403771..88ed79ec2 100644
--- a/components/mbColorLib/SLColorPicker.pas
+++ b/components/mbColorLib/SLColorPicker.pas
@@ -5,74 +5,74 @@ unit SLColorPicker;
interface
uses
- LCLIntf, LCLType, LMessages,
- SysUtils, Classes, Controls, Graphics, Forms,
- mbColorPickerControl;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
+ mbColorConv, mbColorPickerControl;
type
- TSLColorPicker = class(TmbColorPickerControl)
+ TSLColorPicker = class(TmbHSLVColorPickerControl)
private
- FHue, FSat, FLum: Double;
- FMaxHue, FMaxSat, FMaxLum: integer;
- procedure DrawMarker(x, y: integer);
- function GetHue: 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);
- procedure UpdateCoords;
+ FHint: array[TBrightnessMode] of string;
+ function GetHint(AMode: TBrightnessMode): String;
+ procedure SetHint(AMode: TBrightnessMode; AText: String);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
+ procedure DrawMarker(x, y: integer);
function GetGradientColor2D(X, Y: Integer): TColor; override;
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Resize; override;
procedure Paint; override;
- procedure SelectColor(x, y: integer);
+ procedure SelectColor(x, y: integer); override;
+ procedure SetBrightnessMode(AMode: TBrightnessMode); override;
+ procedure SetMaxLum(L: Integer); override;
+ procedure SetMaxSat(S: Integer); override;
+ procedure SetMaxVal(V: Integer); override;
+ procedure SetRelLum(L: Double); override;
+ procedure SetRelSat(S: Double); override;
+ procedure SetRelVal(V: Double); override;
procedure SetSelectedColor(c: TColor); override;
+ procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor;
published
- property Hue: integer read GetHue write SetHue default 0;
- property Saturation: integer read GetSat write SetSat default 0;
- property Luminance: integer read GetLum write SetLum 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 Hue default 0;
+ property Saturation default 0;
+ property Luminance default 255;
+ property Value default 255;
+ property MaxHue default 360;
+ property MaxSaturation default 255;
+ property MaxLuminance default 255;
+ property MaxValue default 255;
property SelectedColor default clWhite;
property MarkerStyle default msCircle;
+ property SLHintFormat: String index bmLuminance read GetHint write SetHint;
+ property SVHintFormat: String index bmValue read GetHint write SetHint;
property OnChange;
end;
implementation
uses
- Math,
- ScanLines, RGBHSLUtils, HTMLColors, mbUtils;
+ HTMLColors, mbUtils;
{ TSLColorPicker }
constructor TSLColorPicker.Create(AOwner: TComponent);
begin
inherited;
- FMaxHue := 359;
- FMaxSat := 240;
- FMaxLum := 240;
- FGradientWidth := FMaxSat + 1; // x --> Saturation
- FGradientHeight := FMaxLum + 1; // y --> Luminance
+ FGradientWidth := FMaxSat + 1; // x --> Saturation
+ case BrightnessMode of
+ bmLuminance : FGradientHeight := FMaxLum + 1; // y --> Luminance
+ bmValue : FGradientHeight := FMaxVal + 1; // y --> value
+ end;
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
- FSelected := clWhite;
- RGBToHSL(FSelected, FHue, FSat, FLum);
- HintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
+ FHue := 0;
+ FSat := 1.0;
+ FLum := 1.0;
+ FVal := 1.0;
+ SLHintFormat := 'S: %hslS L: %l' + LineEnding + 'Hex: %hex';
+ SVHintFormat := 'S: %hslS V: %v' + LineEnding + 'Hex: %hex';
MarkerStyle := msCircle;
end;
@@ -99,135 +99,28 @@ end;
function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
- S, L: Double;
+ S, LV: Double;
begin
S := x / (Width - 1);
- L := 1.0 - y / (Height - 1);
- Result := HSLToRGB(FHue, S, L);
-// Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1));
- if WebSafe then
- Result := GetWebSafe(Result);
+ LV := 1.0 - y / (Height - 1);
+ Result := HSLVtoColor(FHue, S, LV, LV);
end;
-{ This picker has Saturation along the X and Luminance along the Y axis.
-
- NOTE: The HSL conversion (HSLtoColor) seems to be wrong
- but it produces the display seen elsewhere }
+{ This picker has Saturation along the X and Luminance or Value on the Y axis. }
function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
begin
-// Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // wrong formula
- Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // correct, but looks wrong...
+ Result := HSLVtoColor(FHue, x/FMaxSat, 1.0 - y/FMaxLum, 1.0 - y/FMaxVal);
end;
-function TSLColorPicker.GetHue: Integer;
+function TSLColorPicker.GetHint(AMode: TBrightnessMode): String;
begin
- Result := round(FHue * FMaxHue);
-end;
-
-function TSLColorPicker.GetLum: Integer;
-begin
- Result := round(FLum * FMaxLum);
-end;
-
-function TSLColorPicker.GetSat: Integer;
-begin
- Result := round(FSat * FMaxSat);
-end;
-
-procedure TSLColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
-var
- eraseKey: Boolean;
- delta: Integer;
-begin
- eraseKey := true;
- delta := IfThen(ssCtrl in Shift, 10, 1);
-
- case Key of
- VK_LEFT : SelectColor(mx - delta, my);
- VK_RIGHT : SelectColor(mx + delta, my);
- VK_UP : SelectColor(mx, my - delta);
- VK_DOWN : SelectColor(mx, my + delta);
- else eraseKey := false;
- end;
- {
- case Key of
- VK_LEFT:
- if (mdx - delta >= 0) then
- begin
- Dec(mdx, delta);
- SelectionChanged(mdx, mdy);
- FManual := true;
- DoChange;
- end;
- VK_RIGHT:
- if (mdx + delta < Width) then
- begin
- Inc(mdx, delta);
- SelectionChanged(mdx, mdy);
- FManual := true;
- DoChange;
- end;
- VK_UP:
- if (mdy - delta >= 0) then
- begin
- Dec(mdy, delta);
- SelectionChanged(mdx, mdy);
- FManual := true;
- DoChange;
- end;
- VK_DOWN:
- if (mdy + delta < Height) then
- begin
- Inc(mdy, delta);
- SelectionChanged(mdx, mdy);
- FManual := true;
- DoChange;
- end;
- else
- eraseKey := false;
- end;
- }
-
- if eraseKey then
- Key := 0;
-
- inherited;
-end;
-
-procedure TSLColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- Exit;
- if (Button = mbLeft) then
- SelectColor(X, Y);
- SetFocus;
-end;
-
-procedure TSLColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- Exit;
- if (ssLeft in Shift) then
- SelectColor(X, Y);
-end;
-
-procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
-begin
- inherited;
- if csDesigning in ComponentState then
- Exit;
- if (Button = mbLeft)then
- SelectColor(X, Y);
+ Result := FHint[AMode];
end;
procedure TSLColorPicker.Paint;
begin
Canvas.StretchDraw(ClientRect, FBufferBMP);
- UpdateCoords;
+// UpdateCoords;
DrawMarker(mx, my);
end;
@@ -239,88 +132,94 @@ end;
procedure TSLColorPicker.SelectColor(x, y: integer);
var
- S, L: Double;
+ S, LV: Double;
begin
CorrectCoords(x, y);
S := x / (Width - 1);
- L := 1 - y / (Height - 1);
- if (S = FSat) and (L = FLum) then
- exit;
+ LV := 1 - y / (Height - 1);
+ case BrightnessMode of
+ bmLuminance:
+ begin
+ if (S = FSat) and (LV = FLum) then
+ exit;
+ FLum := LV;
+ end;
+ bmValue:
+ begin
+ if (S = FSat) and (LV = FVal) then
+ exit;
+ FVal := LV;
+ end;
+ end;
FSat := S;
- FLum := L;
- FSelected := HSLtoRGB(FHue, FSat, FLum);
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+
Invalidate;
UpdateCoords;
DoChange;
end;
-procedure TSLColorPicker.SetHue(H: integer);
+procedure TSLColorPicker.SetBrightnessMode(AMode: TBrightnessMode);
begin
- Clamp(H, 0, FMaxHue);
- if GetHue() <> H then
- begin
- FHue := h / FMaxHue;
- FSelected := HSLtoRGB(FHue, FSat, FLum);
- CreateGradient;
- UpdateCoords;
- Invalidate;
- DoChange;
- end;
+ inherited;
+ HintFormat := FHint[AMode];
end;
-procedure TSLColorPicker.SetLum(L: integer);
+procedure TSLColorPicker.SetHint(AMode: TBrightnessMode; AText: String);
begin
- Clamp(L, 0, FMaxLum);
- if GetLum() <> L then
- begin
- FLum := L / FMaxLum;
- FSelected := HSLtoRGB(FHue, FSat, FLum);
- UpdateCoords;
- Invalidate;
- DoChange;
- 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;
+ FHint[AMode] := AText;
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;
+ if BrightnessMode = bmLuminance then
+ FGradientHeight := L + 1;
+ inherited;
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;
+ FGradientWidth := S + 1; // inherited will re-create the gradient
+ inherited;
end;
-procedure TSLColorPicker.SetSat(S: integer);
+procedure TSLColorPicker.SetMaxVal(V: Integer);
begin
- Clamp(S, 0, FMaxSat);
- if GetSat() <> S then
+ if V = FMaxVal then
+ exit;
+ if BrightnessMode = bmValue then
+ FGradientHeight := V + 1;
+ inherited;
+end;
+
+procedure TSLColorPicker.SetRelLum(L: Double);
+begin
+ Clamp(L, 0.0, 1.0);
+ if FLum <> L then
begin
- FSat := S / FMaxSat;
- FSelected := HSLtoRGB(FHue, FSat, FLum);
+ FLum := L;
+ if BrightnessMode = bmLuminance then
+ begin
+ FSelected := HSLtoColor(FHue, FSat, FLum);
+ UpdateCoords;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
+procedure TSLColorPicker.SetRelSat(S: Double);
+begin
+ Clamp(S, 0.0, 1.0);
+ if FSat <> S then
+ begin
+ FSat := S;
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
UpdateCoords;
Invalidate;
DoChange;
@@ -329,7 +228,10 @@ end;
procedure TSLColorPicker.SetSelectedColor(c: TColor);
var
- H, S, L: Double;
+ H: Double = 0;
+ S: Double = 0;
+ L: Double = 0;
+ V: Double = 0;
needNewGradient: Boolean;
begin
if WebSafe then
@@ -337,12 +239,14 @@ begin
if c = GetSelectedColor then
exit;
- RGBToHSL(c, H, S, L);
-// ColorToHSL(c, H, S, L);
+ ColorToHSLV(c, H, S, L, V);
needNewGradient := (FHue <> H);
FHue := H;
FSat := S;
- FLum := L;
+ case BrightnessMode of
+ bmLuminance : FLum := L;
+ bmValue : FVal := V;
+ end;
FSelected := c;
UpdateCoords;
if needNewGradient then
@@ -351,10 +255,29 @@ begin
DoChange;
end;
+procedure TSLColorPicker.SetRelVal(V: Double);
+begin
+ Clamp(V, 0.0, 1.0);
+ if FVal <> V then
+ begin
+ FVal := V;
+ if BrightnessMode = bmValue then
+ begin
+ FSelected := HSVtoColor(FHue, FSat, FVal);
+ UpdateCoords;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
procedure TSLColorPicker.UpdateCoords;
begin
mx := round(FSat * (Width - 1));
- my := round((1.0 - FLum) * (Height - 1));
+ case BrightnessMode of
+ bmLuminance : my := round((1.0 - FLum) * (Height - 1));
+ bmValue : my := round((1.0 - FVal) * (Height - 1));
+ end;
end;
diff --git a/components/mbColorLib/SLHColorPicker.pas b/components/mbColorLib/SLHColorPicker.pas
index d47d258e0..834d9c486 100644
--- a/components/mbColorLib/SLHColorPicker.pas
+++ b/components/mbColorLib/SLHColorPicker.pas
@@ -7,7 +7,7 @@ interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms, Menus, Themes,
RGBHSLUtils, mbTrackBarPicker, HTMLColors, SLColorPicker, HColorPicker,
- mbBasicPicker;
+ mbColorConv, mbBasicPicker;
type
TSLHColorPicker = class(TmbBasicPicker)
@@ -15,25 +15,36 @@ type
FSLPicker: TSLColorPicker;
FHPicker: THColorPicker;
FSelectedColor: TColor;
- FHValue, FSValue, FLValue: Double;
- FMaxH, FMaxS, FMaxL: Integer;
- FRValue, FGValue, FBValue: integer;
+// FHValue, FSValue, FLValue: Double;
+// FRed, FGreen, FBlue: integer;
FSLHint, FHHint: string;
FSLMenu, FHMenu: TPopupMenu;
FSLCursor, FHCursor: TCursor;
PBack: TBitmap;
- function GetH: Integer;
- function GetS: Integer;
- function GetL: Integer;
- procedure SetH(H: integer);
- procedure SetS(S: 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);
+ function GetBrightnessMode: TBrightnessMode;
+ function GetHue: Integer;
+ function GetSat: Integer;
+ function GetLum: Integer;
+ function GetVal: Integer;
+ function GetMaxHue: Integer;
+ function GetMaxLum: Integer;
+ function GetMaxSat: Integer;
+ function GetMaxVal: Integer;
+ function GetRed: Integer;
+ function GetGreen: Integer;
+ function GetBlue: Integer;
+ procedure SetBlue(B: integer);
+ procedure SetBrightnessMode(bm: TBrightnessMode);
+ procedure SetGreen(G: integer);
+ procedure SetHue(H: integer);
+ procedure SetLum(L: integer);
+ procedure SetRed(R: integer);
+ procedure SetSat(S: integer);
+ procedure SetVal(V: Integer);
+ procedure SetMaxHue(H: Integer);
+ procedure SetMaxSat(S: Integer);
+ procedure SetMaxLum(L: Integer);
+ procedure SetMaxVal(V: Integer);
procedure SetHHint(h: string);
procedure SetSLHint(h: string);
procedure SetSLMenu(m: TPopupMenu);
@@ -46,10 +57,11 @@ type
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
+ function GetSelectedColor: TColor; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
- procedure SelectColor(c: TColor);
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -59,23 +71,26 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
- property Red: integer read FRValue write SetR default 255;
- property Green: integer read FGValue write SetG default 0;
- property Blue: integer read FBValue write SetB default 0;
+ property Red: integer read GetRed write SetRed default 255;
+ property Green: integer read GetGreen write SetGreen default 0;
+ property Blue: integer read GetBlue write SetBlue default 0;
published
- property Hue: integer read GetH write SetH default 0;
- property Saturation: integer read GetS write SetS default 240;
- property Luminance: integer read GetL write SetL default 120;
- property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
+ property BrightnessMode: TBrightnessMode read GetBrightnessMode
+ write SetBrightnessMode default bmValue;
+ property SelectedColor default clRed;
+ property Hue: integer read GetHue write SetHue default 0;
+ property Saturation: integer read GetSat write SetSat default 255;
+ property Value: Integer read GetVal write SetVal default 255;
+ property Luminance: integer read GetLum write SetLum default 127;
property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
property HPickerHintFormat: string read FHHint write SetHHint;
property SLPickerHintFormat: string read FSLHint write SetSLHint;
property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
- property MaxHue: Integer read FMaxH write SetMaxH default 359;
- property MaxSaturation: Integer read FMaxS write SetMaxS default 240;
- property MaxLuminance: Integer read FMaxL write SetMaxL default 240;
+ property MaxHue: Integer read GetMaxHue write SetMaxHue default 360;
+ property MaxSaturation: Integer read GetMaxSat write SetMaxSat default 240;
+ property MaxLuminance: Integer read GetMaxLum write SetMaxLum default 240;
property TabStop default true;
property ShowHint;
property ParentShowHint;
@@ -107,19 +122,15 @@ begin
inherited;
//ControlStyle := ControlStyle - [csAcceptsControls] + [csOpaque];
- FMaxH := 359;
- FMaxS := 240;
- FMaxL := 240;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
ParentColor := true;
SetInitialBounds(0, 0, WSL + DIST + WH, HSL + 2*VDELTA);
TabStop := true;
- FSelectedColor := clRed;
- FHPicker := THColorPicker.Create(Self);
- InsertControl(FHPicker);
FHCursor := crDefault;
FSLCursor := crDefault;
+ FHHint := 'Hue: %h';
+ FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
// Saturation-Lightness picker
FSLPicker := TSLColorPicker.Create(Self);
@@ -127,28 +138,21 @@ begin
with FSLPicker do
begin
SetInitialBounds(0, VDELTA, WSL, HSL);
- Visible := true;
- SelectedColor := clRed;
- MaxHue := FMaxH;
- MaxSaturation := FMaxS;
- MaxLuminance := FMaxL;
- //Saturation := FMaxS;
- //Luminance := FMaxL;
+ Cursor := FSLCursor;
+ BrightnessMode := bmValue;
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
// Hue picker
+ FHPicker := THColorPicker.Create(Self);
+ InsertControl(FHPicker);
with FHPicker do
begin
+ Cursor := FHCursor;
Layout := lyVertical; // put before setting width and height
SetInitialBounds(WSL + DIST, 0, WH, HSL + 2*VDELTA);
- MaxHue := self.FMaxH;
- MaxSaturation := 255;
- MaxValue := 255;
- //Saturation := MaxSaturation;
- Value := MaxValue;
- Visible := true;
+ BrightnessMode := bmValue;
ArrowPlacement := spBoth;
NewArrowStyle := true;
OnChange := HPickerChange;
@@ -156,14 +160,7 @@ begin
end;
// red
- FHValue := 0;
- FSValue := 1.0;
- FLValue := 0.5;
- FRValue := 255;
- FGValue := 0;
- FBValue := 0;
- FHHint := 'Hue: %h';
- FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
+ SelectedColor := clRed;
end;
destructor TSLHColorPicker.Destroy;
@@ -175,12 +172,6 @@ end;
procedure TSLHColorPicker.DoChange;
begin
FSelectedColor := FSLPicker.SelectedColor;
- FHValue := FHPicker.Hue / FHPicker.MaxHue;
- FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation;
- FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance;
- FRValue := GetRValue(FSelectedColor);
- FGValue := GetGValue(FSelectedColor);
- FBValue := GetBValue(FSelectedColor);
inherited;
end;
@@ -190,14 +181,29 @@ begin
OnMouseMove(Self, Shift, x, y);
end;
+function TSLHColorPicker.GetBrightnessMode: TBrightnessMode;
+begin
+ Result := FSLPicker.BrightnessMode;
+end;
+
function TSLHColorPicker.GetColorUnderCursor: TColor;
begin
Result := FSLPicker.ColorUnderCursor;
end;
-function TSLHColorPicker.GetH: Integer;
+function TSLHColorPicker.GetBlue: Integer;
begin
- Result := Round(FHValue * FMaxH);
+ Result := GetBValue(FSelectedColor);
+end;
+
+function TSLHColorPicker.GetGreen: Integer;
+begin
+ Result := GetGValue(FSelectedColor);
+end;
+
+function TSLHColorPicker.GetHue: Integer;
+begin
+ Result := FHPicker.Hue;
end;
function TSLHColorPicker.GetHexColorUnderCursor: string;
@@ -205,14 +211,44 @@ begin
Result := FSLPicker.GetHexColorUnderCursor;
end;
-function TSLHColorPicker.GetL: Integer;
+function TSLHColorPicker.GetLum: Integer;
begin
- Result := ROund(FLValue * FMaxL);
+ Result := FSLPicker.Luminance;
end;
-function TSLHColorPicker.GetS: Integer;
+function TSLHColorPicker.GetMaxHue: Integer;
begin
- Result := Round(FSValue * FMaxS);
+ Result := FSLPicker.MaxHue;
+end;
+
+function TSLHColorPicker.GetMaxLum: Integer;
+begin
+ Result := FSLPicker.MaxLuminance;
+end;
+
+function TSLHColorPicker.GetMaxSat: Integer;
+begin
+ Result := FSLPicker.MaxSaturation;
+end;
+
+function TSLHColorPicker.GetMaxVal: Integer;
+begin
+ Result := FSLPicker.MaxValue;
+end;
+
+function TSLHColorPicker.GetRed: Integer;
+begin
+ Result := GetRValue(FSelectedColor);
+end;
+
+function TSLHColorPicker.GetSat: Integer;
+begin
+ Result := FSLPicker.Saturation;
+end;
+
+function TSLHColorPicker.GetSelectedColor: TColor;
+begin
+ Result := FSelectedColor;
end;
function TSLHColorPicker.GetSelectedHexColor: string;
@@ -220,6 +256,11 @@ begin
Result := ColorToHex(FSelectedColor);
end;
+function TSLHColorPicker.GetVal: Integer;
+begin
+ REsult := FSLPicker.Value;
+end;
+
procedure TSLHColorPicker.HPickerChange(Sender: TObject);
begin
if FSLPicker.Hue = FHPicker.Hue then
@@ -243,7 +284,6 @@ end;
procedure TSLHColorPicker.Resize;
begin
inherited;
-// PaintParentBack;
if (FSLPicker = nil) or (FHPicker = nil) then
exit;
@@ -255,36 +295,32 @@ begin
FHPicker.Height := Height;
end;
-procedure TSLHColorPicker.SelectColor(c: TColor);
-begin
- FSelectedColor := c;
- FHPicker.Hue := GetHValue(c);
- FSLPicker.SelectedColor := c;
-end;
-
-procedure TSLHColorPicker.SetB(B: integer);
-begin
- FBValue := B;
- SelectColor(RGB(FRValue, FGValue, FBValue));
-end;
-
procedure TSLHColorPicker.SetFocus;
begin
inherited;
FSLPicker.SetFocus;
end;
-procedure TSLHColorPicker.SetH(H: integer);
+procedure TSLHColorPicker.SetBlue(B: integer);
begin
- FHValue := H / FMaxH;
- FSLPicker.Hue := H;
- FHPicker.Hue := H;
+ SetSelectedColor(RgbToColor(Red, Green, B));
end;
-procedure TSLHColorPicker.SetG(G: integer);
+procedure TSLHColorPicker.SetBrightnessMode(bm: TBrightnessMode);
begin
- FGValue := G;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FSLPicker.BrightnessMode := bm;
+ FHPicker.BrightnessMode := bm;
+end;
+
+procedure TSLHColorPicker.SetGreen(G: integer);
+begin
+ SetSelectedColor(RgbToColor(Red, G, Blue));
+end;
+
+procedure TSLHColorPicker.SetHCursor(c: TCursor);
+begin
+ FHCursor := c;
+ FHPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetHHint(h: string);
@@ -299,70 +335,84 @@ begin
FHPicker.PopupMenu := m;
end;
-procedure TSLHColorPicker.SetL(L: integer);
+procedure TSLHColorPicker.SetHue(H: integer);
+begin
+ FHPicker.Hue := H;
+ FSLPicker.Hue := H;
+end;
+
+procedure TSLHColorPicker.SetLum(L: integer);
begin
- FLValue := L / FMaxL;
FSLPicker.Luminance := L;
end;
-procedure TSLHColorPicker.SetMaxH(H: Integer);
+procedure TSLHColorPicker.SetMaxHue(H: Integer);
begin
- FMaxH := H;
FSLPicker.MaxHue := H;
FHPicker.MaxHue := H;
end;
-procedure TSLHColorPicker.SetMaxL(L: Integer);
+procedure TSLHColorPicker.SetMaxLum(L: Integer);
begin
- FMaxL := L;
FSLPicker.MaxLuminance := L;
+ FHPicker.MaxLuminance := L;
end;
-procedure TSLHColorPicker.SetMaxS(S: Integer);
+procedure TSLHColorPicker.SetMaxSat(S: Integer);
begin
- FMaxS := S;
FSLPicker.MaxSaturation := S;
+ FHPicker.MaxSaturation := S;
end;
-procedure TSLHColorPicker.SetR(R: integer);
+procedure TSLHColorPicker.SetMaxVal(V: Integer);
begin
- FRValue := R;
- SelectColor(RGB(FRValue, FGValue, FBValue));
+ FSLPicker.MaxValue := V;
+ FHPicker.MaxValue := V;
end;
-procedure TSLHColorPicker.SetS(S: integer);
+procedure TSLHColorPicker.SetRed(R: integer);
+begin
+ SetSelectedColor(RgbToColor(R, Green, Blue));
+end;
+
+procedure TSLHColorPicker.SetSat(S: integer);
begin
- FSValue := S / FMaxS;
FSLPicker.Saturation := S;
end;
+procedure TSLHColorPicker.SetSelectedColor(c: TColor);
+begin
+ FSelectedColor := c;
+ FHPicker.Hue := GetHValue(c);
+ FSLPicker.SelectedColor := c;
+end;
+
procedure TSLHColorPicker.SetSLHint(h: string);
begin
FSLHint := h;
FSLPicker.HintFormat := h;
end;
-procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu);
-begin
- FSLMenu := m;
- FSLPicker.PopupMenu := m;
-end;
-
-procedure TSLHColorPicker.SetHCursor(c: TCursor);
-begin
- FHCursor := c;
- FHPicker.Cursor := c;
-end;
-
procedure TSLHColorPicker.SetSLCursor(c: TCursor);
begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
+procedure TSLHColorPicker.SetSLMenu(m: TPopupMenu);
+begin
+ FSLMenu := m;
+ FSLPicker.PopupMenu := m;
+end;
+
+procedure TSLHColorPicker.SetVal(V: Integer);
+begin
+ FSLPicker.Value := V;
+end;
+
procedure TSLHColorPicker.SLPickerChange(Sender: TObject);
begin
- if FSLPicker.SelectedColor = FSelectedColor then
+ if FSelectedColor = FSLPicker.SelectedColor then
exit;
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
diff --git a/components/mbColorLib/ScreenWin.pas b/components/mbColorLib/ScreenWin.pas
index 90531a417..a6f421a05 100644
--- a/components/mbColorLib/ScreenWin.pas
+++ b/components/mbColorLib/ScreenWin.pas
@@ -21,9 +21,9 @@ type
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
- procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
+ {%H-}Shift: TShiftState; X, Y: Integer);
+ procedure FormMouseUp(Sender: TObject; {%H-}Button: TMouseButton;
+ {%H-}Shift: TShiftState; X, Y: Integer);
procedure FormShow(Sender: TObject);
private
diff --git a/components/mbColorLib/VColorPicker.pas b/components/mbColorLib/VColorPicker.pas
index 33cf2191d..bc715e80e 100644
--- a/components/mbColorLib/VColorPicker.pas
+++ b/components/mbColorLib/VColorPicker.pas
@@ -7,13 +7,8 @@ interface
{$ENDIF}
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Forms, Graphics,
- RGBHSVUtils, mbTrackBarPicker, HTMLColors, Scanlines;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Forms, Graphics,
+ {RGBHSVUtils,} mbTrackBarPicker, HTMLColors;
type
TVColorPicker = class(TmbTrackBarPicker)
@@ -24,9 +19,7 @@ type
function ValFromArrowPos(p: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
- function GetSelectedColor: TColor;
function GetValue: Integer;
- procedure SetSelectedColor(c: TColor);
procedure SetHue(h: integer);
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
@@ -37,7 +30,9 @@ type
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -47,13 +42,14 @@ type
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
+ property HintFormat;
end;
implementation
uses
- mbUtils;
+ mbUtils, mbColorConv;
{TVColorPicker}
@@ -224,7 +220,7 @@ end;
procedure TVColorPicker.SetSelectedColor(c: TColor);
var
- h, s, v: integer;
+ h, s, v: Double;
needNewGradient: Boolean;
begin
if WebSafe then
@@ -232,7 +228,7 @@ begin
if c = GetSelectedColor then
exit;
- RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
+ RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (h <> FHue) or (s <> FSat);
FHue := h;
FSat := s;
diff --git a/components/mbColorLib/YColorPicker.pas b/components/mbColorLib/YColorPicker.pas
index 4e612b985..529c00899 100644
--- a/components/mbColorLib/YColorPicker.pas
+++ b/components/mbColorLib/YColorPicker.pas
@@ -7,13 +7,8 @@ interface
{$ENDIF}
uses
- {$IFDEF FPC}
- LCLIntf, LCLType, LMessages,
- {$ELSE}
- Windows, Messages,
- {$ENDIF}
- SysUtils, Classes, Controls, Graphics, Forms,
- RGBCMYKUtils, mbTrackBarPicker, HTMLColors, Scanlines;
+ LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
+ RGBCMYKUtils, mbTrackBarPicker, HTMLColors;
type
TYColorPicker = class(TmbTrackBarPicker)
@@ -21,8 +16,6 @@ type
FYellow, FMagenta, FCyan, FBlack: integer;
function ArrowPosFromYellow(y: integer): integer;
function YellowFromArrowPos(p: integer): integer;
- function GetSelectedColor: TColor;
- procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
procedure SetMagenta(m: integer);
procedure SetCyan(c: integer);
@@ -31,7 +24,9 @@ type
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
+ function GetSelectedColor: TColor; override;
function GetSelectedValue: integer; override;
+ procedure SetSelectedColor(clr: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@@ -39,8 +34,9 @@ type
property Magenta: integer read FMagenta write SetMagenta default 0;
property Cyan: integer read FCyan write SetCyan default 0;
property Black: integer read FBlack write SetBlack default 0;
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor default clRed;
+ property SelectedColor default clRed;
property Layout default lyVertical;
+ property HintFormat;
end;
implementation
diff --git a/components/mbColorLib/examples/fulldemo/main.lfm b/components/mbColorLib/examples/fulldemo/main.lfm
index ba204f750..8aafcc27e 100644
--- a/components/mbColorLib/examples/fulldemo/main.lfm
+++ b/components/mbColorLib/examples/fulldemo/main.lfm
@@ -15,10 +15,10 @@ object Form1: TForm1
Height = 404
Top = 6
Width = 476
- ActivePage = TabSheet7
+ ActivePage = TabSheet1
Align = alClient
BorderSpacing.Around = 6
- TabIndex = 7
+ TabIndex = 0
TabOrder = 0
OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove
@@ -31,10 +31,12 @@ object Form1: TForm1
Height = 360
Top = 8
Width = 454
- Saturation = 146
- SelectedColor = 3289805
+ SelectedColor = 3552968
+ Saturation = 147
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex'
LPickerHintFormat = 'Luminance: %l'
+ VPickerHintFormat = 'Value: %value (selected)'
+ MaxLuminance = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = HSLColorPicker1Change
@@ -611,7 +613,10 @@ object Form1: TForm1
Width = 322
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
- SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
+ SLPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
+ SVPickerHintFormat = 'S: %hslS V: %v'#13'Hex: %hex'
+ MaxLuminance = 255
+ MaxSaturation = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = HSLRingPicker1Change
@@ -632,25 +637,22 @@ object Form1: TForm1
HintFormat = 'H: %h S: %s V: %v'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
- OnMouseMove = HSVColorPicker1MouseMove
Saturation = 0
OnChange = HSVColorPicker1Change
end
- object VColorPicker2: TVColorPicker
+ object LVColorPicker1: TLVColorPicker
Left = 437
Height = 375
Top = 2
Width = 22
- HintFormat = 'Value: %v (selected)'
Layout = lyVertical
NewArrowStyle = True
Anchors = [akTop, akRight, akBottom]
TabOrder = 1
- OnChange = VColorPicker2Change
- Hue = 0
- Saturation = 0
- Value = 255
- SelectedColor = clWhite
+ OnChange = LVColorPicker1Change
+ BrightnessMode = bmValue
+ LHintFormat = 'Luminance: %lum (selected)'
+ VHintFormat = 'Value: %value (selected)'
end
end
object TabSheet6: TTabSheet
@@ -663,9 +665,13 @@ object Form1: TForm1
Height = 364
Top = 6
Width = 458
+ SelectedColor = 213
+ Value = 213
Luminance = 100
HPickerHintFormat = 'Hue: %h (selected)'
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
+ MaxSaturation = 255
+ MaxLuminance = 255
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnChange = SLHColorPicker1Change
@@ -782,20 +788,20 @@ object Form1: TForm1
Height = 25
Top = 265
Width = 420
- HintFormat = 'Luminance: %l (selected)'
+ SelectedColor = 460777
SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom]
TabOrder = 2
Hue = 0
Saturation = 240
Luminance = 120
+ HintFormat = 'Luminance: %l (selected)'
end
object VColorPicker1: TVColorPicker
Left = 34
Height = 21
Top = 233
Width = 420
- HintFormat = 'Value: %v (selected)'
ArrowPlacement = spBefore
NewArrowStyle = True
SelectionIndicator = siRect
@@ -804,23 +810,22 @@ object Form1: TForm1
Hue = 0
Saturation = 255
Value = 255
+ HintFormat = 'Value: %v (selected)'
end
object HColorPicker1: THColorPicker
Left = 34
Height = 61
Top = 304
Width = 420
- HintFormat = 'Hue: %h (under mouse)'
+ SelectedColor = 8882175
Increment = 5
ArrowPlacement = spBoth
SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom]
TabOrder = 4
OnGetHintStr = HColorPicker1GetHintStr
- Hue = 0
- Saturation = 120
- Value = 255
- SelectedColor = 8882175
+ Luminance = 195
+ HintFormat = 'Hue: %h (under mouse)'
end
object SColorPicker1: TSColorPicker
AnchorSideTop.Control = OfficeColorDialogButton
@@ -829,7 +834,7 @@ object Form1: TForm1
Height = 291
Top = 74
Width = 19
- HintFormat = 'Saturation: %s (selected)'
+ SelectedColor = 11534335
Layout = lyVertical
ArrowPlacement = spBefore
NewArrowStyle = True
@@ -838,9 +843,8 @@ object Form1: TForm1
BorderSpacing.Top = 8
TabOrder = 5
Hue = 60
- Saturation = 80
- Value = 255
- SelectedColor = 11534335
+ Luminance = 215
+ HintFormat = 'Saturation: %s (selected)'
end
object Memo1: TMemo
AnchorSideLeft.Control = Label9
@@ -903,12 +907,13 @@ object Form1: TForm1
Height = 155
Top = 6
Width = 211
- SelectedColor = 15797774
+ SelectedColor = 15406357
HintFormat = 'H: %h S: %s'#13'Hex: %hex'
TabOrder = 0
OnMouseMove = HSColorPicker1MouseMove
Hue = 240
- Saturation = 214
+ Luminance = 128
+ Saturation = 215
MarkerStyle = msSquare
OnChange = HSColorPicker1Change
end
@@ -917,12 +922,14 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 161
- SelectedColor = 6974058
+ SelectedColor = 6579300
HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex'
TabOrder = 1
OnMouseMove = SLColorPicker1MouseMove
Luminance = 100
MarkerStyle = msCross
+ SLHintFormat = 'S: %hslS L: %l'#13#10'Hex: %hex'
+ SVHintFormat = 'S: %hslS V: %v'#13#10'Hex: %hex'
OnChange = SLColorPicker1Change
end
object HRingPicker1: THRingPicker
@@ -930,13 +937,11 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 133
- SelectedColor = clRed
+ SelectedColor = 66047
HintFormat = 'Hue: %h (selected)'
TabOrder = 2
OnMouseMove = HRingPicker1MouseMove
- Hue = 0
- Saturation = 255
- Value = 255
+ Luminance = 128
OnChange = HRingPicker1Change
end
end
@@ -964,10 +969,10 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
- HintFormat = 'Cyan: %c (selected)'
+ SelectedColor = clAqua
Anchors = [akTop, akLeft, akBottom]
TabOrder = 0
- SelectedColor = clAqua
+ HintFormat = 'Cyan: %c (selected)'
end
object MColorPicker1: TMColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -977,11 +982,11 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
- HintFormat = 'Magenta: %m (selected)'
+ SelectedColor = clFuchsia
ArrowPlacement = spBefore
Anchors = [akTop, akLeft, akBottom]
TabOrder = 1
- SelectedColor = clFuchsia
+ HintFormat = 'Magenta: %m (selected)'
end
object YColorPicker1: TYColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -991,11 +996,11 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 31
- HintFormat = 'Yellow: %y (selected)'
+ SelectedColor = clYellow
ArrowPlacement = spBoth
Anchors = [akTop, akLeft, akBottom]
TabOrder = 2
- SelectedColor = clYellow
+ HintFormat = 'Yellow: %y (selected)'
end
object KColorPicker1: TKColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -1005,13 +1010,13 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
- HintFormat = 'Black: %k (selected)'
+ SelectedColor = 16711422
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 3
Cyan = 0
Black = 1
- SelectedColor = 16711422
+ HintFormat = 'Black: %k (selected)'
end
object RColorPicker1: TRColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -1021,14 +1026,14 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
- HintFormat = 'Red: %r (selected)'
+ SelectedColor = 8026879
ArrowPlacement = spBefore
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 4
Green = 122
Blue = 122
- SelectedColor = 8026879
+ HintFormat = 'Red: %r (selected)'
end
object GColorPicker1: TGColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -1038,14 +1043,14 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 34
- HintFormat = 'Green: %g (selected)'
+ SelectedColor = 8060794
ArrowPlacement = spBoth
NewArrowStyle = True
Anchors = [akTop, akLeft, akBottom]
TabOrder = 5
Red = 122
Blue = 122
- SelectedColor = 8060794
+ HintFormat = 'Green: %g (selected)'
end
object BColorPicker1: TBColorPicker
AnchorSideTop.Control = CColorPicker1
@@ -1055,72 +1060,72 @@ object Form1: TForm1
Height = 353
Top = 19
Width = 22
- HintFormat = 'Blue: %b (selected)'
+ SelectedColor = 16743034
SelectionIndicator = siRect
Anchors = [akTop, akLeft, akBottom]
TabOrder = 6
Green = 122
Red = 122
- SelectedColor = 16743034
+ HintFormat = 'Blue: %b (selected)'
end
object KColorPicker2: TKColorPicker
Left = 322
Height = 79
Top = 27
Width = 69
+ SelectedColor = 16711422
BevelInner = bvRaised
BevelOuter = bvRaised
BorderStyle = bsSingle
- HintFormat = 'Black: %k (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 7
Cyan = 0
Black = 1
- SelectedColor = 16711422
+ HintFormat = 'Black: %k (selected)'
end
object MColorPicker2: TMColorPicker
Left = 320
Height = 61
Top = 110
Width = 91
+ SelectedColor = clFuchsia
BevelInner = bvLowered
BevelOuter = bvRaised
BorderStyle = bsSingle
- HintFormat = 'Magenta: %m (selected)'
Layout = lyHorizontal
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 8
- SelectedColor = clFuchsia
+ HintFormat = 'Magenta: %m (selected)'
end
object CColorPicker2: TCColorPicker
Left = 322
Height = 74
Top = 172
Width = 61
+ SelectedColor = clAqua
BevelInner = bvRaised
BevelOuter = bvLowered
BorderStyle = bsSingle
- HintFormat = 'Cyan: %c (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 9
- SelectedColor = clAqua
+ HintFormat = 'Cyan: %c (selected)'
end
object YColorPicker2: TYColorPicker
Left = 320
Height = 63
Top = 256
Width = 81
+ SelectedColor = clYellow
BevelInner = bvLowered
BevelOuter = bvLowered
BorderStyle = bsSingle
- HintFormat = 'Yellow: %y (selected)'
ArrowPlacement = spBoth
NewArrowStyle = True
TabOrder = 10
- SelectedColor = clYellow
+ HintFormat = 'Yellow: %y (selected)'
end
end
object TabSheet10: TTabSheet
diff --git a/components/mbColorLib/examples/fulldemo/main.pas b/components/mbColorLib/examples/fulldemo/main.pas
index f77a21430..13b111cb6 100644
--- a/components/mbColorLib/examples/fulldemo/main.pas
+++ b/components/mbColorLib/examples/fulldemo/main.pas
@@ -4,16 +4,18 @@ interface
uses
- LCLIntf, LCLType, SysUtils, Variants,Classes, Graphics, Controls,
- Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
+ LCLIntf, LCLType, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils,
SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker,
- HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker,
- SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl,
- BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker,
- MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo,
- CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker,
- mbColorTree, mbColorList {for internet shortcuts}, mbBasicPicker;
+ HColorPicker, LVColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker,
+ SLColorPicker, HSColorPicker, IniFiles, mbColorPickerControl, BColorPicker,
+ GColorPicker, RColorPicker, KColorPicker, YColorPicker, MColorPicker,
+ CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo, CIELColorPicker,
+ BAxisColorPicker, GAxisColorPicker, RAxisColorPicker, mbColorTree,
+ mbColorList, mbBasicPicker,
+
+ VColorPicker;
type
@@ -63,7 +65,6 @@ type
HSColorPicker1: THSColorPicker;
SLColorPicker1: TSLColorPicker;
HRingPicker1: THRingPicker;
- VColorPicker2: TVColorPicker;
CheckBox1: TCheckBox;
CbMarker: TComboBox;
Label4: TLabel;
@@ -82,6 +83,7 @@ type
TabSheet9: TTabSheet;
CColorPicker1: TCColorPicker;
MColorPicker1: TMColorPicker;
+ LVColorPicker1: TLVColorPicker;
YColorPicker1: TYColorPicker;
KColorPicker1: TKColorPicker;
Label8: TLabel;
@@ -131,8 +133,6 @@ type
procedure HSLRingPicker1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure HSVColorPicker1Change(Sender: TObject);
- procedure HSVColorPicker1MouseMove(Sender: TObject; Shift: TShiftState;
- X, Y: Integer);
procedure SLHColorPicker1Change(Sender: TObject);
procedure SLHColorPicker1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
@@ -149,7 +149,7 @@ type
Y: Integer);
procedure udSizeChangingEx(Sender: TObject; var AllowChange: Boolean;
NewValue: SmallInt; Direction: TUpDownDirection);
- procedure VColorPicker2Change(Sender: TObject);
+ procedure LVColorPicker1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CbMarkerChange(Sender: TObject);
@@ -176,7 +176,8 @@ implementation
{$R mxico.res} //MXS icon resource file, for internet shortcut only
uses
- RGBHSLUtils;
+ mbColorConv;
+// RGBHSLUtils;
procedure TForm1.tb1Change(Sender: TObject);
begin
@@ -244,15 +245,9 @@ end;
procedure TForm1.HSVColorPicker1Change(Sender: TObject);
begin
- sc.color := HSVColorPicker1.SelectedColor;
- VColorPicker2.Saturation := HSVColorPicker1.Saturation;
- VColorPicker2.Hue := HSVColorPicker1.Hue;
-end;
-
-procedure TForm1.HSVColorPicker1MouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
-begin
-uc.Color := HSVColorPicker1.ColorUnderCursor;
+ LVColorPicker1.Saturation := HSVColorPicker1.Saturation;
+ LVColorPicker1.Hue := HSVColorPicker1.Hue;
+ sc.color := LVColorPicker1.SelectedColor;
end;
procedure TForm1.SLHColorPicker1Change(Sender: TObject);
@@ -322,17 +317,19 @@ begin
uc.color := hringpicker1.ColorUnderCursor;
end;
-procedure TForm1.VColorPicker2Change(Sender: TObject);
+procedure TForm1.LVColorPicker1Change(Sender: TObject);
begin
- HSVColorPicker1.Value := VColorPicker2.Value;
+ if (sc = nil) or (uc = nil) or (LVColorPicker1 = nil) or (HSVColorPicker1 = nil) then
+ exit;
+ LVColorPicker1.Saturation := HSVColorPicker1.Saturation;
+ LVColorPicker1.Hue := HSVColorPicker1.Hue;
+ sc.Color := LVColorPicker1.SelectedColor;
+ uc.Color := HSVtoColor(HSVColorPicker1.RelHue, HSVColorPicker1.RelSaturation, HSVColorPicker1.RelValue);
end;
// only for internet shortcuts
procedure TForm1.FormCreate(Sender: TObject);
begin
-// MaxHue := 360;
-// MaxSat := 240;
-// MaxLum := 240;
with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\MXS Website.url') do
try
WriteString('InternetShortcut','URL', 'http://mxs.bergsoft.net');
diff --git a/components/mbColorLib/mbBasicPicker.pas b/components/mbColorLib/mbBasicPicker.pas
index 1f89a5aee..a9dec134e 100644
--- a/components/mbColorLib/mbBasicPicker.pas
+++ b/components/mbColorLib/mbBasicPicker.pas
@@ -25,14 +25,16 @@ type
procedure CreateGradient; virtual;
procedure DoChange; virtual;
function GetColorUnderCursor: TColor; virtual;
- function GetGradientColor(AValue: Integer): TColor; virtual;
- function GetGradientColor2D(X, Y: Integer): TColor; virtual;
+ function GetGradientColor({%H-}AValue: Integer): TColor; virtual;
+ function GetGradientColor2D({%H-}X, {%H-}Y: Integer): TColor; virtual;
function GetHintPos(X, Y: Integer): TPoint; virtual;
function GetHintStr(X, Y: Integer): String; virtual;
+ function GetSelectedColor: TColor; virtual; abstract;
procedure PaintParentBack; virtual; overload;
procedure PaintParentBack(ACanvas: TCanvas); overload;
procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
procedure PaintParentBack(ABitmap: TBitmap); overload;
+ procedure SetSelectedColor(c: TColor); virtual; abstract;
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
property ColorUnderCursor: TColor read GetColorUnderCursor;
@@ -46,6 +48,7 @@ type
function GetHexColorUnderCursor: string; virtual;
published
property ParentColor default true;
+ property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
end;
implementation
diff --git a/components/mbColorLib/mbColorPalette.pas b/components/mbColorLib/mbColorPalette.pas
index 3403836a3..664c4acd7 100644
--- a/components/mbColorLib/mbColorPalette.pas
+++ b/components/mbColorLib/mbColorPalette.pas
@@ -64,7 +64,7 @@ type
procedure DrawCell(ACanvas: TCanvas; AColor: string);
procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
function GetColorUnderCursor: TColor; override;
- function GetHintStr(X, Y: Integer): String; override;
+ function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
function GetIndexUnderCursor: integer;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
@@ -146,8 +146,6 @@ type
implementation
-uses
- mbUtils;
{ TmbColorPalette }
@@ -684,6 +682,7 @@ begin
FNames.Clear;
FColors.Text := ReadJASCPal(FileName);
end
+ (*
else if SameText(ExtractFileExt(FileName), '.aco') then
begin
supported := true;
@@ -702,6 +701,7 @@ begin
FNames.Clear;
FColors.Text := ReadPhotoshopAct(FileName);
end
+ *)
else
raise Exception.Create('The file format you are trying to load is not supported in this version of the palette'#13'Please send a request to MXS along with the files of this format so'#13'loading support for this file can be added too');
if supported then
diff --git a/components/mbColorLib/mbColorPickerControl.pas b/components/mbColorLib/mbColorPickerControl.pas
index 7dfea8500..b464ea859 100644
--- a/components/mbColorLib/mbColorPickerControl.pas
+++ b/components/mbColorLib/mbColorPickerControl.pas
@@ -6,7 +6,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms, Themes,
- RGBHSLUtils, RGBHSVUtils, RGBCMYKUtils, RGBCIEUtils, HTMLColors, mbBasicPicker;
+ HTMLColors, mbColorConv, mbBasicPicker;
type
TMarkerStyle = (msCircle, msSquare, msCross, msCrossCirc);
@@ -21,24 +21,22 @@ type
procedure SetMarkerStyle(s: TMarkerStyle);
procedure SetWebSafe(s: boolean);
protected
- FManual: Boolean;
FSelected: TColor;
mx, my: integer;
procedure CreateGradient; override;
- function GetHintStr(X, Y: Integer): String; override;
- function GetSelectedColor: TColor; virtual;
+ function GetHintStr({%H-}X, {%H-}Y: Integer): String; override;
+ function GetSelectedColor: TColor; override;
procedure InternalDrawMarker(X, Y: Integer; C: TColor);
- procedure SetSelectedColor(C: TColor); virtual;
+ procedure SetSelectedColor(C: TColor); override;
procedure WebSafeChanged; dynamic;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
- procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
+// procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
public
constructor Create(AOwner: TComponent); override;
property ColorUnderCursor;
published
- property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
property HintFormat: string read FHintFormat write FHintFormat;
property WebSafe: boolean read FWebSafe write SetWebSafe default false;
end;
@@ -78,11 +76,70 @@ type
property OnStartDrag;
end;
+ TmbHSLVColorPickerControl = class(TmbColorPickerControl)
+ private
+ FBrightnessMode: TBrightnessMode;
+ function GetHue: Integer;
+ function GetLum: Integer;
+ function GetSat: Integer;
+ function GetVal: Integer;
+ function GetRed: Integer;
+ function GetGreen: Integer;
+ function GetBlue: Integer;
+ procedure SetHue(h: integer);
+ procedure SetLum(L: Integer);
+ procedure SetSat(s: integer);
+ procedure SetVal(v: integer);
+ procedure SetRed(R: Integer);
+ procedure SetGreen(G: Integer);
+ procedure SetBlue(B: Integer);
+ protected
+ FHue, FSat, FLum, FVal: Double;
+ FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer;
+ procedure ColorToHSLV(c: TColor; var H, S, L, V: Double);
+ procedure CorrectCoords(var x, y: integer);
+ function HSLVtoColor(H, S, L, V: Double): TColor;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
+ procedure SelectColor({%H-}x, {%H-}y: Integer); virtual;
+ procedure SetBrightnessMode(AMode: TBrightnessMode); virtual;
+ procedure SetMaxHue(H: Integer); virtual;
+ procedure SetMaxLum(L: Integer); virtual;
+ procedure SetMaxSat(S: Integer); virtual;
+ procedure SetMaxVal(V: Integer); virtual;
+ procedure SetRelHue(H: Double); virtual;
+ procedure SetRelLum(L: Double); virtual;
+ procedure SetRelSat(S: Double); virtual;
+ procedure SetRelVal(V: Double); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property RelHue: Double read FHue write SetRelHue;
+ property RelSaturation: Double read FSat write SetRelSat;
+ property RelLuminance: Double read FLum write SetRelLum;
+ property RelValue: Double read FVal write SetRelVal;
+ property Red: Integer read GetRed write SetRed;
+ property Green: Integer read GetGreen write SetGreen;
+ property Blue: Integer read GetBlue write SetBlue;
+ published
+ property BrightnessMode: TBrightnessMode
+ read FBrightnessMode write SetBrightnessMode default bmLuminance;
+ property Hue: integer read GetHue write SetHue;
+ property Luminance: Integer read GetLum write SetLum;
+ property Saturation: integer read GetSat write SetSat;
+ property Value: integer read GetVal write SetVal;
+ property MaxHue: Integer read FMaxHue write SetMaxHue default 360;
+ property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
+ property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
+ property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
+ end;
+
implementation
uses
- IntfGraphics, fpimage,
- ScanLines, PalUtils, SelPropUtils;
+ Math, IntfGraphics, fpimage,
+ PalUtils, SelPropUtils, mbUtils;
constructor TmbCustomPicker.Create(AOwner: TComponent);
begin
@@ -107,14 +164,14 @@ begin
inherited;
Invalidate;
end;
-
+ (*
procedure TmbCustomPicker.CMMouseLeave(var Message: TLMessage);
begin
mx := 0;
my := 0;
inherited;
end;
-
+ *)
procedure TmbCustomPicker.CreateGradient;
var
x, y: Integer;
@@ -205,4 +262,282 @@ begin
Invalidate;
end;
+
+{ TmbHSLVColorPickerControl }
+
+constructor TmbHSLVColorPickerControl.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBrightnessMode := bmLuminance;
+ FMaxHue := 360;
+ FMaxSat := 255;
+ FMaxVal := 255;
+ FMaxLum := 255;
+end;
+
+procedure TmbHSLVColorPickerControl.ColorToHSLV(c: TColor;
+ var H, S, L, V: Double);
+begin
+ case FBrightnessMode of
+ bmLuminance : ColorToHSL(c, H, S, L);
+ bmValue : ColorToHSV(c, H, S, V);
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.CorrectCoords(var x, y: integer);
+begin
+ Clamp(x, 0, Width - 1);
+ Clamp(y, 0, Height - 1);
+end;
+
+function TmbHSLVColorPickerControl.GetBlue: Integer;
+begin
+ Result := GetBValue(GetSelectedColor);
+end;
+
+function TmbHSLVColorPickerControl.GetGreen: Integer;
+begin
+ Result := GetGValue(GetSelectedColor);
+end;
+
+function TmbHSLVColorPickerControl.GetHue: Integer;
+begin
+ Result := Round(FHue * FMaxHue);
+end;
+
+function TmbHSLVColorPickerControl.GetLum: Integer;
+begin
+ Result := Round(FLum * FMaxLum);
+end;
+
+function TmbHSLVColorPickerControl.GetRed: Integer;
+begin
+ Result := GetRValue(GetSelectedColor);
+end;
+
+function TmbHSLVColorPickerControl.GetSat: Integer;
+begin
+ Result := Round(FSat * FMaxSat);
+end;
+
+function TmbHSLVColorPickerControl.GetVal: Integer;
+begin
+ Result := Round(FVal * FMaxVal);
+end;
+
+function TmbHSLVColorPickerControl.HSLVtoColor(H, S, L, V: Double): TColor;
+begin
+ case FBrightnessMode of
+ bmLuminance : Result := HSLToColor(H, S, L);
+ bmValue : Result := HSVtoColor(H, S, V);
+ end;
+ if WebSafe then
+ Result := GetWebSafe(Result);
+end;
+
+procedure TmbHSLVColorPickerControl.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ eraseKey: Boolean;
+ delta: Integer;
+begin
+ eraseKey := true;
+ delta := IfThen(ssCtrl in Shift, 10, 1);
+
+ case Key of
+ VK_LEFT : SelectColor(mx - delta, my);
+ VK_RIGHT : SelectColor(mx + delta, my);
+ VK_UP : SelectColor(mx, my - delta);
+ VK_DOWN : SelectColor(mx, my + delta);
+ else eraseKey := false;
+ end;
+
+ if eraseKey then
+ Key := 0;
+
+ inherited;
+end;
+
+procedure TmbHSLVColorPickerControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ inherited;
+ if csDesigning in ComponentState then
+ Exit;
+ if Button = mbLeft then
+ SelectColor(x, y);
+ SetFocus;
+end;
+
+procedure TmbHSLVColorPickerControl.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ inherited;
+ if csDesigning in ComponentState then
+ Exit;
+ if ssLeft in Shift then
+ SelectColor(x, y);
+end;
+
+procedure TmbHSLVColorPickerControl.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ inherited;
+ if csDesigning in ComponentState then
+ Exit;
+ if Button = mbLeft then
+ SelectColor(x, y);
+end;
+
+procedure TmbHSLVColorPickerControl.SelectColor(x, y: Integer);
+begin
+end;
+
+procedure TmbHSLVColorPickerControl.SetBlue(B: Integer);
+begin
+ Clamp(B, 0, 255);
+ SetSelectedColor(RgbToColor(Red, Green, B));
+end;
+
+procedure TmbHSLVColorPickerControl.SetBrightnessMode(AMode: TBrightnessMode);
+var
+ c: TColor;
+begin
+ c := HSLVtoColor(FHue, FSat, FLum, FVal);
+ FBrightnessMode := AMode;
+ ColorToHSLV(c, FHue, FSat, FLum, FVal);
+ CreateGradient;
+ Invalidate;
+ DoChange;
+end;
+
+procedure TmbHSLVColorPickerControl.SetGreen(G: Integer);
+begin
+ Clamp(G, 0, 255);
+ SetSelectedColor(RgbToColor(Red, G, Blue));
+end;
+
+procedure TmbHSLVColorPickerControl.SetHue(H: Integer);
+begin
+ SetRelHue(H / FMaxHue);
+end;
+
+procedure TmbHSLVColorPickerControl.SetLum(L: Integer);
+begin
+ SetRelLum(L / FMaxLum);
+end;
+
+procedure TmbHSLVColorPickerControl.SetMaxHue(h: Integer);
+begin
+ if h = FMaxHue then
+ exit;
+ FMaxHue := h;
+ CreateGradient;
+ Invalidate;
+end;
+
+procedure TmbHSLVColorPickerControl.SetMaxLum(L: Integer);
+begin
+ if L = FMaxLum then
+ exit;
+ FMaxLum := L;
+ if BrightnessMode = bmLuminance then begin
+ CreateGradient;
+ Invalidate;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetMaxSat(S: Integer);
+begin
+ if S = FMaxSat then
+ exit;
+ FMaxSat := S;
+ CreateGradient;
+ Invalidate;
+end;
+
+procedure TmbHSLVColorPickerControl.SetMaxVal(V: Integer);
+begin
+ if V = FMaxVal then
+ exit;
+ FMaxVal := V;
+ if BrightnessMode = bmLuminance then
+ begin
+ CreateGradient;
+ Invalidate;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetRed(R: Integer);
+begin
+ Clamp(R, 0, 255);
+ SetSelectedColor(RgbToColor(R, Green, Blue));
+end;
+
+procedure TmbHSLVColorPickerControl.SetRelHue(H: Double);
+begin
+ Clamp(H, 0, 1.0);
+ if FHue <> H then
+ begin
+ FHue := H;
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetRelLum(L: Double);
+begin
+ Clamp(L, 0, 1.0);
+ if FLum <> L then
+ begin
+ FLum := L;
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+ if BrightnessMode = bmLuminance then begin
+ CreateGradient;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetRelSat(S: Double);
+begin
+ Clamp(S, 0, 1.0);
+ if FSat <> S then
+ begin
+ FSat := S;
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetRelVal(V: Double);
+begin
+ Clamp(v, 0, 1.0);
+ if FVal <> V then
+ begin
+ FVal := V;
+ if BrightnessMode = bmValue then
+ begin
+ FSelected := HSLVtoColor(FHue, FSat, FLum, FVal);
+ CreateGradient;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVColorPickerControl.SetSat(S: Integer);
+begin
+ SetRelSat(S / FMaxSat);
+end;
+
+procedure TmbHSLVColorPickerControl.SetVal(V: Integer);
+begin
+ SetRelVal(V / FMaxVal);
+end;
+
+
end.
diff --git a/components/mbColorLib/mbColorTree.pas b/components/mbColorLib/mbColorTree.pas
index ca7eac9c7..515fce8b7 100644
--- a/components/mbColorLib/mbColorTree.pas
+++ b/components/mbColorLib/mbColorTree.pas
@@ -35,12 +35,12 @@ type
protected
procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
- Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override;
+ {%H-}Stage: TCustomDrawStage; var {%H-}PaintImages: Boolean): Boolean; override;
procedure DoArrow(c: TCanvas; dir: TScrollDirection; p: TPoint; sel: boolean);
procedure DrawColorItem(R: TRect; Selected: boolean; AIndex: Integer;
AItemText: String; Expanded: boolean); dynamic;
procedure DrawInfoItem(R: TRect; Index: integer); dynamic;
- function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
+ function IsCustomDrawn({%H-}Target: TCustomDrawTarget; {%H-}Stage: TCustomDrawStage): Boolean; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
diff --git a/components/mbColorLib/mbDeskPickerButton.pas b/components/mbColorLib/mbDeskPickerButton.pas
index 128114982..522bc715d 100644
--- a/components/mbColorLib/mbDeskPickerButton.pas
+++ b/components/mbColorLib/mbDeskPickerButton.pas
@@ -60,8 +60,8 @@ type
var Handled: Boolean);
public
constructor Create(AOwner: TComponent); override;
- procedure ExecuteTarget(Target: TObject); override;
- function HandlesTarget(Target: TObject): Boolean; override;
+ procedure ExecuteTarget({%H-}Target: TObject); override;
+ function HandlesTarget({%H-}Target: TObject): Boolean; override;
// procedure UpdateTarget(Target: TObject); override;
published
property Caption;
diff --git a/components/mbColorLib/mbOfficeColorDialog.pas b/components/mbColorLib/mbOfficeColorDialog.pas
index 3f84ac31a..3bf7fc567 100644
--- a/components/mbColorLib/mbOfficeColorDialog.pas
+++ b/components/mbColorLib/mbOfficeColorDialog.pas
@@ -15,15 +15,16 @@ type
FSelColor: TColor;
FUseHint: boolean;
FMaxHue, FMaxSat, FMaxLum: Integer;
+ FPickerIndex: Integer;
public
constructor Create(AOwner: TComponent); override;
function Execute: boolean; overload;
function Execute(AColor: TColor): boolean; overload;
published
property SelectedColor: TColor read FSelColor write FSelColor default clWhite;
- property MaxHue: Integer read FMaxHue write FMaxHue default 359;
- property MaxSaturation: Integer read FMaxSat write FMaxSat default 240;
- property MaxLuminance: Integer read FMaxLum write FMaxLum default 240;
+ property MaxHue: Integer read FMaxHue write FMaxHue default 360;
+ property MaxSaturation: Integer read FMaxSat write FMaxSat default 255;
+ property MaxLuminance: Integer read FMaxLum write FMaxLum default 255;
property UseHints: boolean read FUseHint write FUseHint default false;
end;
@@ -36,9 +37,9 @@ begin
inherited;
FSelColor := clWhite;
FUseHint := false;
- FMaxHue := 359;
- FMaxSat := 240;
- FMaxLum := 240;
+ FMaxHue := 360;
+ FMaxSat := 255;
+ FMaxLum := 255;
end;
function TmbOfficeColorDialog.Execute: boolean;
@@ -50,16 +51,19 @@ function TmbOfficeColorDialog.Execute(AColor: TColor): boolean;
begin
FWin := TOfficeMoreColorsWin.Create(Application);
try
- FWin.OldSwatch.Color := AColor;
FWin.ShowHint := FUseHint;
FWin.MaxHue := FMaxHue;
FWin.MaxSaturation := FMaxSat;
FWin.MaxLuminance := FMaxLum;
+ FWin.PickerIndex := FPickerIndex;
+// FWin.OldSwatch.Color := AColor;
+ FWin.SelectedColor := AColor;
Result := (FWin.ShowModal = IdOK);
if Result then
- FSelColor := FWin.NewSwatch.Color
+ FSelColor := FWin.SelectedColor //FWin.NewSwatch.Color
else
FSelColor := clNone;
+ FPickerIndex := FWin.PickerIndex;
finally
FWin.Free;
end;
diff --git a/components/mbColorLib/mbReg.lrs b/components/mbColorLib/mbReg.lrs
index 220cb86b4..ce2ad44fa 100644
--- a/components/mbColorLib/mbReg.lrs
+++ b/components/mbColorLib/mbReg.lrs
@@ -646,3 +646,15 @@ LazarusResources.Add('TVColorPicker','PNG',[
+' '#12'H'#3#162#0'Y'#128',A%P'#23#160'F'#208'#'#168#145#238#208'._'#200#185
+#241#12'o'#213'fM'#147#161'f;'#0#0#0#0'IEND'#174'B`'#130
]);
+LazarusResources.Add('TLVColorPicker','PNG',[
+ #137'PNG'#13#10#26#10#0#0#0#13'IHDR'#0#0#0#24#0#0#0#24#8#6#0#0#0#224'w='#248#0
+ +#0#0#9'pHYs'#0#0#11#19#0#0#11#19#1#0#154#156#24#0#0#0#163'IDATH'#199#237#149
+ +'1'#10#195'0'#12'E'#191'\'#155#128'e'#199#6#15#6#239#134#244'&9_.'#147'k'#197
+ +'''P'#183#210#165#161#164#205#208'`'#129#16#130'/'#189'E'#31#145#136#224#204
+ +#208'89:'#224#183#128#24#163#180#214#16'B@J'#9'9g'#148'RPJ'#193#178','#244'5'
+ +'`'#219'6'#138'1'#202'0'#12'0'#198'@k'#13#165'no'#151#3#0#29'9'#211#233'>'
+ +#201#232'G'#164#148#176#174'+'#237#138'E'#228'P'#206#243','#159#232#232':FSJ'
+ +#9'3'#131#153#225#156#131#181#22#206#185'g'#191'W_'#231#152#25#222'{'#169#181
+ +#170#238#228#14#248#19#0#245#151'y}'#192#3#148#140'h'#197#198'%'#238'5'#0#0#0
+ +#0'IEND'#174'B`'#130
+]);
diff --git a/components/mbColorLib/mbReg.pas b/components/mbColorLib/mbReg.pas
index a9a370c1c..4b6962134 100644
--- a/components/mbColorLib/mbReg.pas
+++ b/components/mbColorLib/mbReg.pas
@@ -19,7 +19,7 @@ uses
RAxisColorPicker, GAxisColorPicker, BAxisColorPicker,
CColorPicker, MColorPicker, YColorPicker, KColorPicker,
HRingPicker,
- HColorPicker, SColorPicker, LColorPicker, VColorPicker,
+ HColorPicker, SColorPicker, LVColorPicker, LColorPicker, VColorPicker,
HSColorPicker, HSVColorPicker, HSLColorPicker, HSLRingPicker,
SLColorPicker, SLHColorPicker,
CIEAColorPicker, CIEBColorPicker, CIELColorPicker,
@@ -34,7 +34,7 @@ begin
TRAxisColorPicker, TGAxisColorPicker, TBAxisColorPicker,
TCColorPicker, TMColorPicker, TYColorPicker, TKColorPicker,
THRingPicker,
- THColorPicker, TSColorPicker, TLColorPicker, TVColorPicker,
+ THColorPicker, TSColorPicker, TLVColorPicker, TLColorPicker, TVColorPicker,
THSColorPicker, THSVColorPicker, THSLColorPicker, THSLRingPicker,
TSLColorPicker, TSLHColorPicker,
TCIEAColorPicker, TCIEBColorPicker, TCIELColorPicker,
diff --git a/components/mbColorLib/mbTrackBarPicker.pas b/components/mbColorLib/mbTrackBarPicker.pas
index b26f49e37..b7f635516 100644
--- a/components/mbColorLib/mbTrackBarPicker.pas
+++ b/components/mbColorLib/mbTrackBarPicker.pas
@@ -7,7 +7,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Classes, Controls, Graphics, Forms,
Themes, ExtCtrls,
- PalUtils, mbBasicPicker;
+ PalUtils, mbColorConv, mbBasicPicker;
const
TBA_Resize = 0;
@@ -86,6 +86,7 @@ type
procedure SetBorderStyle(Value: TBorderStyle); override;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
+ property HintFormat: string read FHintFormat write FHintFormat;
public
constructor Create(AOwner: TComponent); override;
@@ -96,7 +97,6 @@ type
property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone;
property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
- property HintFormat: string read FHintFormat write FHintFormat;
property Increment: integer read FIncrement write FIncrement default 1;
property Layout: TTrackBarLayout read FLayout write SetLayout default lyHorizontal;
property ArrowPlacement: TSliderPlacement read FPlacement write SetPlacement default spAfter;
@@ -140,11 +140,58 @@ type
property OnStartDrag;
end;
+ { TmbHSLVTrackbarPicker }
+
+ TmbHSLVTrackbarPicker = class(TmbTrackbarPicker)
+ private
+ FBrightnessMode: TBrightnessMode;
+ function GetHue: Integer;
+ function GetLum: Integer;
+ function GetSat: Integer;
+ function GetVal: Integer;
+ procedure SetHue(h: integer);
+ procedure SetLum(L: Integer);
+ procedure SetSat(s: integer);
+ procedure SetVal(v: integer);
+ protected
+ FHue, FSat, FLum, FVal: Double;
+ FMaxHue, FMaxSat, FMaxLum, FMaxVal: Integer;
+ procedure ColorToHSLV(c: TColor; var H, S, L, V: Double);
+ function GetSelectedColor: TColor; override;
+ function HSLVtoColor(H, S, L, V: Double): TColor;
+ procedure SetBrightnessMode(AMode: TBrightnessMode); virtual;
+ procedure SetMaxHue(h: Integer); virtual;
+ procedure SetMaxLum(L: Integer); virtual;
+ procedure SetMaxSat(s: Integer); virtual;
+ procedure SetMaxVal(v: Integer); virtual;
+ procedure SetRelHue(H: Double); virtual;
+ procedure SetRelLum(L: Double); virtual;
+ procedure SetRelSat(S: Double); virtual;
+ procedure SetRelVal(V: Double); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property RelHue: Double read FHue write SetRelHue;
+ property RelSaturation: Double read FSat write SetRelSat;
+ property RelLuminance: Double read FLum write SetRelLum;
+ property RelValue: Double read FVal write SetRelVal;
+ published
+ property BrightnessMode: TBrightnessMode
+ read FBrightnessMode write SetBrightnessMode default bmLuminance;
+ property Hue: integer read GetHue write SetHue;
+ property Luminance: Integer read GetLum write SetLum;
+ property Saturation: integer read GetSat write SetSat;
+ property Value: integer read GetVal write SetVal;
+ property MaxHue: Integer read FMaxHue write SetMaxHue default 360;
+ property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
+ property MaxLuminance: Integer read FMaxLum write SetMaxLum default 255;
+ property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
+ end;
+
implementation
uses
IntfGraphics, fpimage, Math,
- ScanLines, HTMLColors;
+ mbUtils, HTMLColors;
const
{ 3D border styles }
@@ -634,7 +681,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseDown);
- //Invalidate;
end;
inherited;
end;
@@ -653,7 +699,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseMove);
-// Invalidate;
end;
inherited;
end;
@@ -666,7 +711,6 @@ begin
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseUp);
-// Invalidate;
end;
inherited;
@@ -804,4 +848,186 @@ begin
Result := pos;
end;
+
+{ TmbHSLVTrackbarPicker }
+
+constructor TmbHSLVTrackbarPicker.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBrightnessMode := bmLuminance;
+ FMaxHue := 360;
+ FMaxSat := 255;
+ FMaxVal := 255;
+ FMaxLum := 255;
+end;
+
+procedure TmbHSLVTrackbarPicker.ColorToHSLV(c: TColor; var H, S, L, V: Double);
+begin
+ case FBrightnessMode of
+ bmLuminance : ColorToHSL(c, H, S, L);
+ bmValue : ColorToHSV(c, H, S, V);
+ end;
+end;
+
+function TmbHSLVTrackbarPicker.GetHue: Integer;
+begin
+ Result := round(FHue * FMaxHue);
+end;
+
+function TmbHSLVTrackbarPicker.GetLum: Integer;
+begin
+ Result := round(FLum * FMaxLum);
+end;
+
+function TmbHSLVTrackbarPicker.GetSat: Integer;
+begin
+ Result := round(FSat * FMaxSat);
+end;
+
+function TmbHSLVTrackbarPicker.GetSelectedColor: TColor;
+begin
+ Result := HSLVtoColor(FHue, FSat, FLum, FVal);
+end;
+
+function TmbHSLVTrackbarPicker.GetVal: Integer;
+begin
+ Result := round(FVal * FMaxVal);
+end;
+
+function TmbHSLVTrackbarPicker.HSLVtoColor(H, S, L, V: Double): TColor;
+begin
+ case FBrightnessMode of
+ bmLuminance : Result := HSLToColor(H, S, L);
+ bmValue : Result := HSVtoColor(H, S, V);
+ end;
+ if WebSafe then
+ Result := GetWebSafe(Result);
+end;
+
+procedure TmbHSLVTrackbarPicker.SetBrightnessMode(AMode: TBrightnessMode);
+var
+ c: TColor;
+begin
+ c := HSLVtoColor(FHue, FSat, FLum, FVal);
+ FBrightnessMode := AMode;
+ ColorToHSLV(c, FHue, FSat, FLum, FVal);
+ CreateGradient;
+ Invalidate;
+ DoChange;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetHue(H: Integer);
+begin
+ SetRelHue(H / FMaxHue);
+end;
+
+procedure TmbHSLVTrackbarPicker.SetLum(L: Integer);
+begin
+ SetRelLum(L / FMaxLum);
+end;
+
+procedure TmbHSLVTrackbarPicker.SetMaxHue(h: Integer);
+begin
+ if h = FMaxHue then
+ exit;
+ FMaxHue := h;
+ FGradientWidth := FMaxHue; // we don't want to access H=360, i.e. don't use FMaxHue+1
+ //CreateGradient;
+ Invalidate;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetMaxLum(L: Integer);
+begin
+ if L = FMaxLum then
+ exit;
+ FMaxLum := L;
+ if FBrightnessMode = bmLuminance then begin
+ //CreateGradient;
+ Invalidate;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetMaxSat(S: Integer);
+begin
+ if S = FMaxSat then
+ exit;
+ FMaxSat := S;
+ //CreateGradient;
+ Invalidate;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetMaxVal(V: Integer);
+begin
+ if V = FMaxVal then
+ exit;
+ FMaxVal := V;
+ if FBrightnessMode = bmValue then begin
+ //CreateGradient;
+ Invalidate;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetRelHue(H: Double);
+begin
+ Clamp(H, 0, 1 - 1/FMaxHue); // don't go up to 360 because this will flip back to the start
+ if (FHue <> H) then
+ begin
+ FHue := H;
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetRelLum(L: Double);
+begin
+ Clamp(L, 0, 1.0);
+ if (FLum <> L) then
+ begin
+ FLum := L;
+ if BrightnessMode = bmLuminance then begin
+ CreateGradient;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetRelSat(S: Double);
+begin
+ Clamp(S, 0, 1.0);
+ if FSat <> S then
+ begin
+ FSat := S;
+ CreateGradient;
+ Invalidate;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetRelVal(V: Double);
+begin
+ Clamp(V, 0, 1.0);
+ if FVal <> V then
+ begin
+ FVal := V;
+ if BrightnessMode = bmValue then
+ begin
+ CreateGradient;
+ Invalidate;
+ end;
+ DoChange;
+ end;
+end;
+
+procedure TmbHSLVTrackbarPicker.SetSat(S: Integer);
+begin
+ SetRelSat(S / FMaxSat);
+end;
+
+procedure TmbHSLVTrackbarPicker.SetVal(V: Integer);
+begin
+ SetRelVal(V / FMaxVal);
+end;
+
end.
diff --git a/components/mbColorLib/mbcolorconv.pas b/components/mbColorLib/mbcolorconv.pas
new file mode 100644
index 000000000..fb98beeed
--- /dev/null
+++ b/components/mbColorLib/mbcolorconv.pas
@@ -0,0 +1,316 @@
+unit mbColorConv;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Graphics;
+
+type
+ TBrightnessMode = (bmLuminance, bmValue);
+
+{ HSL color model }
+
+function HSLtoColor(H, S, L: double): TColor;
+procedure HSLtoRGB(H, S, L: Double; out R, G, B: Integer);
+
+procedure ColortoHSL(c: TColor; out H, S, L: Double);
+procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
+
+{ HSV color model }
+
+procedure ColorToHSV(c: TColor; out H, S, V: Double);
+procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
+
+function HSVtoColor(H, S, V: Double): TColor;
+procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
+
+
+implementation
+
+uses
+ Math, LclIntf;
+
+function modulo(x, y: Double): Double;
+begin
+ Result := x - floor(x / y) * y;
+end;
+
+//==============================================================================
+// HSL color model
+//==============================================================================
+
+function HSLToColor(H, S, L: Double): TColor;
+var
+ R, G, B: Integer;
+begin
+ HSLtoRGB(H, S, L, R, G, B);
+ Result := RGBtoColor(R, G, B);
+end;
+ (*
+procedure HSLtoRGB(H, S, L: double; out R, G, B: Integer);
+var
+ C, X, m: Double;
+ rr, gg, bb: Double;
+begin
+ H := H * 360;
+ C := (1 - abs(2*L - 1)) * S;
+ X := C * (1 - abs(modulo(H / 60, 2) - 1));
+ m := L - C/2;
+ if H < 60 then
+ begin
+ R := round((C + m) * 255);
+ G := round((X + m) * 255);
+ B := round(m * 255);
+ end else
+ if H < 120 then
+ begin
+ R := round((X + m) * 255);
+ G := round((C + m) * 255);
+ B := round(m * 255);
+ end else
+ if H < 180 then
+ begin
+ R := round(m * 255);
+ G := round((C + m) * 255);
+ B := round((X + m) * 255);
+ end else
+ if H < 240 then
+ begin
+ R := round(m * 255);
+ G := round((X + m) * 255);
+ B := round((C + m) * 255);
+ end else
+ if H < 300 then
+ begin
+ R := round((X + m) * 255);
+ G := round(m * 255);
+ B := round((C + m) * 255);
+ end else
+ begin
+ R := round((C + m) * 255);
+ G := round(m * 255);
+ B := round((X + m) * 255);
+ end;
+end; *)
+
+
+procedure HSLtoRGB(H, S, L: double; out R, G, B: Integer);
+var
+ M1, M2: double;
+
+ function HueToColorValue(Hue: double): byte;
+ var
+ V : double;
+ begin
+ if Hue > 10 then
+ Hue := Hue + 1;
+ if Hue < 0 then
+ Hue := Hue + 1
+ else if Hue > 1 then
+ Hue := Hue - 1;
+ if 6 * Hue < 1 then
+ V := M1 + (M2 - M1) * Hue * 6
+ else if 2 * Hue < 1 then
+ V := M2
+ else if 3 * Hue < 2 then
+ V := M1 + (M2 - M1) * (2/3 - Hue) * 6
+ else
+ V := M1;
+ Result := round(255 * V)
+ end;
+
+begin
+ if S = 0 then
+ begin
+ R := round(255 * L);
+ G := R;
+ B := R
+ end
+ else
+ begin
+ if L <= 0.5 then
+ M2 := L * (1 + S)
+ else
+ M2 := L + S - L * S;
+ M1 := 2 * L - M2;
+ R := HueToColorValue(H + 1/3);
+ G := HueToColorValue(H);
+ B := HueToColorValue(H - 1/3)
+ end;
+end;
+
+procedure ColorToHSL(c: TColor; out H, S, L: Double);
+begin
+ RGBtoHSL(GetRValue(c), GetGValue(c), GetBValue(c), H, S, L);
+end;
+
+// From: http://www.rapidtables.com/convert/color/rgb-to-hsl.htm
+procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
+var
+ rr, gg, bb, Cmax, Cmin, delta: double;
+begin
+ rr := R / 255;
+ gg := G / 255;
+ bb := B / 255;
+ Cmax := MaxValue([rr, gg, bb]);
+ Cmin := MinValue([rr, gg, bb]);
+ delta := (Cmax - Cmin);
+ if delta = 0 then
+ begin
+ H := 0;
+ S := 0;
+ end else
+ begin
+ // Calculate L
+ L := (Cmax + Cmin) / 2;
+
+ // Calculate H
+ if Cmax = rr then
+ begin
+ H := modulo((gg - bb) / delta, 6);
+ {
+ H := ((gg - bb) / delta);
+ H := H - floor(H / 6);
+ }
+ H := H * 60;
+ end else
+ if Cmax = gg then
+ H := 60 * ((bb - rr) / delta + 2)
+ else
+ if Cmax = bb then
+ H := 60 * ((rr - gg) / delta + 4)
+ else
+ H := 0;
+ H := H / 360;
+
+ // Calculate S
+ S := delta / (1 - abs(2 * L - 1));
+ end;
+end;
+
+
+ (*
+procedure RGBtoHSL(R, G, B: Integer; out H, S, L: Double);
+var
+ rr, gg, bb, D, Cmax, Cmin: double;
+begin
+ rr := R / 255;
+ gg := G / 255;
+ bb := B / 255;
+ Cmax := MaxValue([rr, gg, bb]);
+ Cmin := MinValue([rr, gg, bb]);
+ 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 := (gg - bb) / D
+ else if G = Cmax then
+ H := 2 + (bb - rr) /D
+ else
+ H := 4 + (rr - gg) / D;
+ H := H / 6;
+ if H < 0 then
+ H := H + 1;
+ end;
+end;
+*)
+
+//==============================================================================
+// HSV color model
+//==============================================================================
+
+{ Assumes H, S, V in the range 0..1 and calculates the R, G, B values which are
+ returned to be in the range 0..255.
+ From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c
+}
+procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
+var
+ i: Integer;
+ f: Double;
+ p, q, t: Double;
+
+ procedure MakeRgb(rr, gg, bb: Double);
+ begin
+ R := Round(rr * 255);
+ G := Round(gg * 255);
+ B := Round(bb * 255);
+ end;
+
+begin
+ i := floor(H * 6);
+ f := H * 6 - i;
+ p := V * (1 - S);
+ q := V * (1 - f*S);
+ t := V * (1 - (1 - f) * S);
+ case i mod 6 of
+ 0: MakeRGB(V, t, p);
+ 1: MakeRGB(q, V, p);
+ 2: MakeRGB(p, V, t);
+ 3: MakeRGB(p, q, V);
+ 4: MakeRGB(t, p, V);
+ 5: MakeRGB(V, p, q);
+ else MakeRGB(0, 0, 0);
+ end;
+end;
+
+function HSVToColor(H, S, V: Double): TColor;
+var
+ r, g, b: Integer;
+begin
+ HSVtoRGB(H, S, V, r, g, b);
+ Result := RgbToColor(r, g, b);
+end;
+
+{ Assumes R, G, B to be in range 0..255. Calculates H, S, V in range 0..1
+ From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c }
+
+procedure ColorToHSV(c: TColor; out H, S, V: Double);
+begin
+ RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), H, S, V);
+end;
+
+procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
+var
+ rr, gg, bb: Double;
+ cmax, cmin, delta: Double;
+begin
+ rr := R / 255;
+ gg := G / 255;
+ bb := B / 255;
+ cmax := MaxValue([rr, gg, bb]);
+ cmin := MinValue([rr, gg, bb]);
+ delta := cmax - cmin;
+ if delta = 0 then
+ begin
+ H := 0;
+ S := 0;
+ end else
+ begin
+ if cmax = rr then
+ H := (gg - bb) / delta + IfThen(gg < bb, 6, 0)
+ else if cmax = gg then
+ H := (bb - rr) / delta + 2
+ else if (cmax = bb) then
+ H := (rr -gg) / delta + 4;
+ H := H / 6;
+ S := delta / cmax;
+ end;
+ V := cmax;
+end;
+
+end.
+
diff --git a/components/mbColorLib/mbcolorliblaz.lpk b/components/mbColorLib/mbcolorliblaz.lpk
index 1721ccc7a..af2a60ff6 100644
--- a/components/mbColorLib/mbcolorliblaz.lpk
+++ b/components/mbColorLib/mbcolorliblaz.lpk
@@ -15,7 +15,7 @@
-
+
@@ -202,6 +202,14 @@
+
+
+
+
+
+
+
+
diff --git a/components/mbColorLib/mbutils.pas b/components/mbColorLib/mbutils.pas
index a3bca921b..9b8d2135e 100644
--- a/components/mbColorLib/mbutils.pas
+++ b/components/mbColorLib/mbutils.pas
@@ -21,6 +21,7 @@ function IsEmptyRect(R: TRect): Boolean;
const
EMPTY_RECT: TRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
+ TWO_PI = 2.0 * pi;
implementation