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

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

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

10
components/mbColorLib/BColorPicker.pas
View File

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

24
components/mbColorLib/CColorPicker.pas
View File

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

10
components/mbColorLib/GColorPicker.pas
View File

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

4
components/mbColorLib/HColorPicker.pas
View File

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

274
components/mbColorLib/HRingPicker.pas
View File

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

307
components/mbColorLib/HSColorPicker.pas
View File

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

139
components/mbColorLib/HSLColorPicker.pas
View File

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

116
components/mbColorLib/HSLRingPicker.pas
View File

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

289
components/mbColorLib/HSVColorPicker.pas
View File

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

11
components/mbColorLib/KColorPicker.pas
View File

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

191
components/mbColorLib/LColorPicker.pas
View File

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

11
components/mbColorLib/MColorPicker.pas
View File

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

22
components/mbColorLib/OfficeMoreColorsDialog.pas
View File

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

4
components/mbColorLib/PalUtils.pas
View File

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

10
components/mbColorLib/RColorPicker.pas
View File

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

80
components/mbColorLib/RGBCMYKUtils.pas
View File

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

148
components/mbColorLib/RGBHSLUtils.pas
View File

@ -15,17 +15,23 @@ uses
Graphics, Math, Scanlines;
var //set these variables to your needs, e.g. 360, 255, 255
MaxHue: integer = 359; //239;
MaxSat: integer = 100; //240;
MaxLum: integer = 100; //240;
MaxHue: integer = 359;
MaxSat: integer = 240;
MaxLum: integer = 240;
function HSLtoRGB(H, S, L: double): TColor;
function HSLRangeToRGB(H, S, L: integer): TColor;
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function HSLtoColor(H, S, L: Double): TColor;
procedure RGBtoHSL(RGB: TColor; out H, S, L: Double);
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
function HSLtoRGB (H, S, L: double): TColor;
function HSLRangeToRGB (H, S, L: integer): TColor;
procedure RGBtoHSLRange (RGB: TColor; var H1, S1, L1 : integer);
function GetHValue(AColor: TColor): integer;
function GetSValue(AColor: TColor): integer;
function GetLValue(AColor: TColor): integer;
//procedure Clamp(var Input: integer; Min, Max: integer);
function HSLToRGBTriple(H, S, L : integer) : TRGBTriple;
function HSLToRGBQuad(H, S, L: integer): TRGBQuad;
procedure RGBTripleToHSL(RGBTriple : TRGBTriple; var h, s, l: integer);
@ -35,6 +41,92 @@ implementation
uses
mbUtils;
procedure ColorToHSL(AColor: TColor; var H, S, L: Double);
function RGBMaxValue(r, g, b: Double): Double;
begin
Result := r;
if (Result < g) then Result := g;
if (Result < b) then Result := b;
end;
function RGBMinValue(r, g, b: Double): Double;
begin
Result := r;
if (Result > g) then Result := g;
if (Result > b) then Result := b;
end;
var
r, g, b: Double;
delta, min: Double;
begin
r := GetRValue(AColor)/255;
g := GetGValue(AColor)/255;
b := GetBValue(AColor)/255;
L := RGBMaxValue(r, g, b);
min := RGBMinValue(r, g, b);
delta := L - min;
if (L = min) then
begin
H := 0.0;
S := 0.0;
end
else
begin
S := delta / L;
if r = L then
H := 60 * (g - b)/delta
else if g = L then
H := 60 * (b - r)/delta + 120
else if b = L then
H := 60 * (r - g)/delta + 240;
if H < 0 then H := H + 360;
H := H / 360;
end;
end;
function HSLtoColor(H, S, L: Double): TColor;
const
Divisor = 255*60;
var
hTemp, f, LS, p, q, r: integer;
intH, intS, intL: Integer;
begin
intH := round(H*360);
intS := round(S*255);
intL := round(L*255);
if intH > 360 then dec(intH, 360);
if intH < 0 then inc(intH, 360);
Clamp(intS, 0, 255);
Clamp(intL, 0, 255);
if (intS = 0) then
Result := RGBtoColor(intL, intL, intL)
else
begin
hTemp := intH mod 360;
f := hTemp mod 60;
hTemp := hTemp div 60;
LS := intL * intS;
p := intL - LS div 255;
q := intL - (LS*f) div Divisor;
r := intL - (LS*(60 - f)) div Divisor;
case hTemp of
0: Result := RGBtoColor(intL, r, p);
1: Result := RGBtoColor(q, intL, p);
2: Result := RGBtoColor(p, intL, r);
3: Result := RGBtoColor(p, q, intL);
4: Result := RGBtoColor(r, p, intL);
5: Result := RGBtoColor(intL, p, q);
else
Result := RGBtoColor(0, 0, 0);
end;
end;
end;
// =============================================================================
function HSLtoRGB(H, S, L: double): TColor;
var
M1, M2: double;
@ -89,7 +181,45 @@ begin
Result := HSLToRGB(H / MaxHue, S / MaxSat, L / MaxLum);
end;
procedure RGBtoHSLRange(RGB: TColor; var H1, S1, L1: integer);
//==============================================================================
procedure RGBtoHSL(RGB: TColor; out H, S, L: Double);
var
R, G, B, D, Cmax, Cmin: double;
begin
R := GetRValue(RGB) / 255;
G := GetGValue(RGB) / 255;
B := GetBValue(RGB) / 255;
Cmax := Max(R, Max(G, B));
Cmin := Min(R, Min(G, B));
L := (Cmax + Cmin) / 2;
if Cmax = Cmin then
begin
H := 0;
S := 0;
end
else
begin
D := Cmax - Cmin;
//calc S
if L < 0.5 then
S := D / (Cmax + Cmin)
else
S := D / (2 - Cmax - Cmin);
//calc H
if R = Cmax then
H := (G - B) / D
else if G = Cmax then
H := 2 + (B - R) /D
else
H := 4 + (R - G) / D;
H := H / 6;
if H < 0 then
H := H + 1;
end;
end;
procedure RGBtoHSLRange(RGB: TColor; out H1, S1, L1: integer);
var
R, G, B, D, Cmax, Cmin, h, s, l: double;
begin
@ -131,6 +261,8 @@ begin
L1 := round(L * MaxLum);
end;
// =============================================================================
function GetHValue(AColor: TColor): integer;
var
d, h: integer;

2
components/mbColorLib/SColorPicker.pas
View File

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

307
components/mbColorLib/SLColorPicker.pas
View File

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

124
components/mbColorLib/SLHColorPicker.pas
View File

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

2
components/mbColorLib/VColorPicker.pas
View File

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

11
components/mbColorLib/YColorPicker.pas
View File

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

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

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

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

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

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

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

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

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

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

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

6
components/mbColorLib/mbBasicPicker.pas
View File

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

1
components/mbColorLib/mbDeskPickerButton.pas
View File

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

1
components/mbColorLib/mbTrackBarPicker.pas
View File

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