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

mbColorLib: Refactor OnChange events. (NOTE: OfficeColorDialog may hang when switching pickers).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5578 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2017-01-02 00:05:26 +00:00
parent 176aff8ff1
commit 454f0baf7b
41 changed files with 1830 additions and 1837 deletions
Download Patch File Download Diff File Expand all files Collapse all files

139
components/mbColorLib/BAxisColorPicker.pas
View File

@ -29,6 +29,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
@ -46,7 +47,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TBAxisColorPicker}
@ -120,54 +121,19 @@ var
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if mxx < 0 then mxx := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if mxx >= Width then mxx := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
@ -176,14 +142,7 @@ procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SelectColor(x, y);
SetFocus;
end;
@ -191,32 +150,14 @@ procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SelectColor(x, y);
end;
procedure TBAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
if Button = mbLeft then
SelectColor(x, y);
end;
procedure TBAxisColorPicker.Paint;
@ -227,20 +168,44 @@ end;
procedure TBAxisColorPicker.Resize;
begin
FManual := false;
mxx := round(FR * Width / 255);
myy := round((255 - FG) * Height / 255);
inherited;
end;
procedure TBAxisColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
r, g, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
mxx := x;
myy := y;
c := GetColorAtPoint(x, y);
if c = FSelected then
exit;
FSelected := c;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
needNewGradient := b <> FB;
FR := r;
FG := g;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TBAxisColorPicker.SetBValue(b: integer);
begin
Clamp(b, 0, 255);
if b <> FB then
begin
FB := b;
CreateGradient;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBToColor(FR, FG, FB));
end;
end;
@ -248,36 +213,40 @@ procedure TBAxisColorPicker.SetGValue(g: integer);
begin
Clamp(g, 0, 255);
FG := g;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBtoColor(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);
FR := r;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBtoColor(FR, FG, FB));
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if b <> FB then
CreateGradient;
needNewGradient := (b <> FB);
FR := r;
FG := g;
FB := b;
FSelected := c;
FManual := true;
mxx := Round(FR * Width / 255); // RED is on x
myy := Round((255 - FG) * Height / 255); // GREEN is on y
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
DoChange;
end;
end.

62
components/mbColorLib/BColorPicker.pas
View File

@ -56,14 +56,9 @@ begin
FGradientHeight := 1;
FRed := 128;
FGreen := 128;
FBlue := 255;
FArrowPos := ArrowPosFromBlue(255);
FChange := false;
Layout := lyVertical;
SetBlue(255);
Layout := lyVertical;
HintFormat := 'Blue: %value (selected)';
FManual := false;
FChange := true;
end;
function TBColorPicker.ArrowPosFromBlue(b: integer): integer;
@ -88,10 +83,12 @@ function TBColorPicker.BlueFromArrowPos(p: integer): integer;
var
b: integer;
begin
if Layout = lyHorizontal then
b := Round(p * 255 / (Width - 12))
else
case Layout of
lyHorizontal:
b := Round(p * 255 / (Width - 12));
lyVertical:
b := Round(255 - p * 255 / (Height - 12));
end;
Clamp(b, 0, 255);
Result := b;
end;
@ -102,11 +99,11 @@ begin
TBA_Resize:
SetBlue(FBlue);
TBA_MouseMove:
FBlue := BlueFromArrowPos(FArrowPos);
SetBlue(BlueFromArrowPos(FArrowPos));
TBA_MouseDown:
FBlue := BlueFromArrowPos(FArrowPos);
SetBlue(BlueFromArrowPos(FArrowPos));
TBA_MouseUp:
FBlue := BlueFromArrowPos(FArrowPos);
SetBlue(BlueFromArrowPos(FArrowPos));
TBA_WheelUp:
SetBlue(FBlue + Increment);
TBA_WheelDown:
@ -145,10 +142,9 @@ end;
function TBColorPicker.GetSelectedColor: TColor;
begin
if not WebSafe then
Result := RGB(FRed, FGreen, FBlue)
else
Result := GetWebSafe(RGB(FRed, FGreen, FBlue));
Result := RGB(FRed, FGreen, FBlue);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TBColorPicker.GetSelectedValue: integer;
@ -163,9 +159,8 @@ begin
begin
FBlue := b;
FArrowPos := ArrowPosFromBlue(b);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -175,10 +170,9 @@ begin
if FGreen <> g then
begin
FGreen := g;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -188,25 +182,33 @@ begin
if FRed <> r then
begin
FRed := r;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TBColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
newGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetRed(GetRValue(c));
SetGreen(GetGValue(c));
SetBlue(GetBValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
newGradient := (r <> FRed) and (g <> FGreen);
FGreen := g;
FBlue := b;
FRed := r;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
end.

143
components/mbColorLib/CColorPicker.pas
View File

@ -52,17 +52,12 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 1;
FCyan := 255;
FMagenta := 0;
FYellow := 0;
FBlack := 0;
FArrowPos := ArrowPosFromCyan(255);
FChange := false;
Layout := lyVertical;
SetCyan(255);
Layout := lyVertical;
HintFormat := 'Selected cyan value: %value';
FManual := false;
FChange := true;
end;
function TCColorPicker.ArrowPosFromCyan(c: integer): integer;
@ -71,13 +66,12 @@ var
begin
if Layout = lyHorizontal then
begin
a := Round(((Width - 12)/255)*c);
a := Round((Width - 12) / 255 * c);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
c := 255 - c;
a := Round(((Height - 12)/255)*c);
a := Round((Height - 12) * (255 - c) / 255);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -88,10 +82,12 @@ function TCColorPicker.CyanFromArrowPos(p: integer): integer;
var
c: integer;
begin
if Layout = lyHorizontal then
c := Round(p/((Width - 12)/255))
else
c := Round(255 - p/((Height - 12)/255));
case Layout of
lyHorizontal:
c := Round(p * 255 / (Width - 12));
lyVertical:
c := Round(255 - p * 255 / (Height - 12));
end;
Clamp(c, 0, 255);
Result := c;
end;
@ -102,11 +98,11 @@ begin
TBA_Resize:
SetCyan(FCyan);
TBA_MouseMove:
FCyan := CyanFromArrowPos(FArrowPos);
SetCyan(CyanFromArrowPos(FArrowPos));
TBA_MouseDown:
FCyan := CyanFromArrowPos(FArrowPos);
SetCyan(CyanFromArrowPos(FArrowPos));
TBA_MouseUp:
FCyan := CyanFromArrowPos(FArrowPos);
SetCyan(CyanFromArrowPos(FArrowPos));
TBA_WheelUp:
SetCyan(FCyan + Increment);
TBA_WheelDown:
@ -137,63 +133,12 @@ begin
Result := ArrowPosFromCyan(FCyan);
end;
// Note: AValue is restricted to the range 0..255 by the size of the trackbar.
function TCColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := CMYKtoColor(AValue, FMagenta, FYellow, FBlack);
end;
procedure TCColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TCColorPicker.SetCyan(C: integer);
begin
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
FArrowPos := ArrowPosFromCyan(c);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TCColorPicker.SetMagenta(m: integer);
begin
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TCColorPicker.SetYellow(y: integer);
begin
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TCColorPicker.GetSelectedColor: TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
@ -206,23 +151,73 @@ begin
Result := FCyan;
end;
procedure TCColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TCColorPicker.SetCyan(C: integer);
begin
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
FArrowPos := ArrowPosFromCyan(c);
Invalidate;
DoChange;
end;
end;
procedure TCColorPicker.SetMagenta(m: integer);
begin
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TCColorPicker.SetYellow(y: integer);
begin
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TCColorPicker.SetSelectedColor(clr: TColor);
var
c, m, y, k: integer;
newGradient: Boolean;
begin
if WebSafe then clr := GetWebSafe(clr);
if WebSafe then
clr := GetWebSafe(clr);
if clr = GetSelectedColor then
exit;
ColorToCMYK(clr, c, m, y, k);
FChange := false;
newGradient := (m <> FMagenta) or (y <> FYellow) or (k <> FBlack);
FMagenta := m;
FYellow := y;
FBlack := k;
FCyan := c;
FManual := false;
if newGradient then
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
FManual := false;
FChange := true;
DoChange;
end;
end.

170
components/mbColorLib/CIEAColorPicker.pas
View File

@ -8,7 +8,7 @@ interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
@ -30,6 +30,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
@ -47,7 +48,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TCIEAColorPicker}
@ -62,7 +63,6 @@ begin
FL := 100;
FA := 127;
FB := -128;
FManual := false;
dx := 0;
dy := 0;
mxx := 0;
@ -112,7 +112,7 @@ end;
}
function TCIEAColorPicker.GetColorAtPoint(x, y: Integer): TColor;
var
l, b: Integer; //Double;
l, b: Integer;
begin
l := round((1 - y / (Height - 1)) * 100);
b := round((x / (Width - 1) - 0.5) * 255);
@ -132,76 +132,28 @@ var
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if mxx < 0 then mxx := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if mxx >= Width then mxx := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIEAColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SelectColor(x, y);
SetFocus;
end;
@ -209,32 +161,15 @@ procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SelectColor(X, Y);
end;
procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIEAColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
if Button = mbLeft then
SelectColor(X, Y);
end;
procedure TCIEAColorPicker.Paint;
@ -245,12 +180,41 @@ end;
procedure TCIEAColorPicker.Resize;
begin
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round(((100 - FL) * 255 / 100) * Height / 255);
mxx := Round((FB + 128) / 255 * Width);
// myy := Round(((100 - FL) * 255 / 100) * Height / 255);
myy := Round((100 - FL) / 100 * Height);
inherited;
end;
procedure TCIEAColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
l, a, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
c := GetColorAtPoint(x, y);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
mxx := x;
myy := y;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := a <> FA;
FSelected := c;
FL := l;
FA := a;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TCIEAColorPicker.SetAValue(a: integer);
begin
Clamp(a, -128, 127);
@ -273,18 +237,30 @@ begin
end;
procedure TCIEAColorPicker.SetSelectedColor(c: TColor);
var
l, a, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := a <> FA;
FL := l;
FA := a;
FB := b;
FSelected := c;
FManual := false;
mxx := Round((FB + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100 * Height / 255);
// myy := Round((100 - FL) * 255 / 100 * Height / 255);
myy := Round((100 - FL) / 100 * Height);
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
DoChange;
end;
end.

180
components/mbColorLib/CIEBColorPicker.pas
View File

@ -8,7 +8,7 @@ interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
SysUtils, Classes, Controls, Graphics, Forms,
HTMLColors, RGBCIEUtils, mbColorPickerControl;
type
@ -33,14 +33,15 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
published
property LValue: integer read FL write SetLValue default 100;
property AValue: integer read FA write SetAValue default -128;
property BValue: integer read FB write SetBValue default 127;
property LValue: integer read FL write SetLValue default 100;
property MarkerStyle default msCircle;
property SelectedColor default clLime;
property OnChange;
@ -50,7 +51,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TCIEBColorPicker}
@ -65,7 +66,6 @@ begin
FL := 100;
FA := -128;
FB := 127;
FManual := false;
dx := 0;
dy := 0;
mxx := 0;
@ -115,10 +115,10 @@ end;
}
function TCIEBColorPicker.GetColorAtPoint(x, y: Integer): TColor;
var
l, a: Double;
l, a: Integer;
begin
l := (1 - y / (Height - 1)) * 100;
a := (x / (Width - 1) - 0.5) * 255;
l := Round((1 - y / (Height - 1)) * 100);
a := Round((x / (Width - 1) - 0.5) * 255);
Result := LabToRGB(l, a, FB);
end;
@ -135,107 +135,44 @@ var
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if myy >= Width then myy := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIEBColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
end;
SelectColor(X, Y);
SetFocus;
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SelectColor(X, Y);
end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
SelectColor(X, Y);
end;
procedure TCIEBColorPicker.Paint;
@ -246,12 +183,41 @@ end;
procedure TCIEBColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA + 128) * (Width / 255));
myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
// myy := Round(((100 - FL) * 255 / 100) * (Height / 255));
myy := Round(( 100 - FL) / 100 * Height);
inherited;
end;
procedure TCIEBColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
l, a, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
c := GetColorAtPoint(x, y);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
mxx := x;
myy := y;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := b <> FB;
FSelected := c;
FL := l;
FA := a;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TCIEBColorPicker.SetAValue(a: integer);
begin
Clamp(a, -128, 127);
@ -274,18 +240,30 @@ begin
end;
procedure TCIEBColorPicker.SetSelectedColor(c: TColor);
var
l, a, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := (b <> FB);
FL := l;
FA := a;
FB := b;
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100* Height / 255);
// myy := Round((100 - FL) * 255 / 100* Height / 255);
myy := Round((100 - FL) / 100 * Height);
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
DoChange;
end;
end.

154
components/mbColorLib/CIELColorPicker.pas
View File

@ -30,6 +30,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(X, Y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
@ -68,7 +69,6 @@ begin
mxx := 0;
myy := 0;
MarkerStyle := msCircle;
SetSelectedColor(clAqua);
end;
procedure TCIELColorPicker.CorrectCoords(var x, y: integer);
@ -130,72 +130,28 @@ var
delta: Integer;
begin
erasekey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if mxx < 0 then mxx := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if mxx >= Width then mxx := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_Right : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIELColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
SelectColor(X, Y);
SetFocus;
end;
@ -203,32 +159,15 @@ procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SelectColor(X, Y);
end;
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
if Button = mbLeft then
SelectColor(X, Y);
end;
procedure TCIELColorPicker.Paint;
@ -246,6 +185,35 @@ begin
inherited;
end;
procedure TCIELColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
l, a, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
c := GetColorAtPoint(x, y);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
mxx := x;
myy := y;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := l <> FL;
FSelected := c;
FL := l;
FA := a;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TCIELColorPicker.SetAValue(a: integer);
begin
Clamp(A, -128, 127);
@ -268,19 +236,29 @@ begin
end;
procedure TCIELColorPicker.SetSelectedColor(c: TColor);
var
l, a, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
FL := Round(GetCIELValue(c));
FA := Round(GetCIEAValue(c));
FB := Round(GetCIEBValue(c));
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
l := Round(GetCIELValue(c));
a := Round(GetCIEAValue(c));
b := Round(GetCIEBValue(c));
needNewGradient := l <> FL;
FL := l;
FA := a;
FB := b;
FSelected := c;
FManual := false;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
DoChange;
end;
end.

146
components/mbColorLib/GAxisColorPicker.pas
View File

@ -29,6 +29,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
@ -46,7 +47,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TGAxisColorPicker}
@ -119,73 +120,26 @@ var
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
if mxx < 0 then mxx := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
if mxx >= Width then mxx := Width - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
inherited;
end;
procedure TGAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TGAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if Button = mbLeft then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SelectColor(x, y);
SetFocus;
end;
@ -193,32 +147,15 @@ procedure TGAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := X;
myy := Y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
end;
SelectColor(x, y);
end;
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := X;
myy := Y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
end;
if Button = mbLeft then
SelectColor(x, y);
end;
procedure TGAxisColorPicker.Paint;
@ -230,16 +167,43 @@ end;
procedure TGAxisColorPicker.Resize;
begin
FManual := false;
myy := Round((255 - FR) * Height / 255);
mxx := Round(FB * Width / 255);
myy := Round((255 - FR) * Height / 255);
inherited;
end;
procedure TGAxisColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
r, g, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
mxx := x;
myy := y;
c := GetColorAtPoint(x, y);
if c = FSelected then
exit;
FSelected := c;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
needNewGradient := g <> FG;
FR := r;
FG := g;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TGAxisColorPicker.SetBValue(b: integer);
begin
Clamp(b, 0, 255);
FB := b;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBToColor(FR, FG, FB));
end;
procedure TGAxisColorPicker.SetGValue(g: integer);
@ -248,8 +212,7 @@ begin
if FG = g then
begin
FG := g;
CreateGradient;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBToColor(FR, FG, FB));
end;
end;
@ -257,28 +220,33 @@ procedure TGAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);
FR := r;
SetSelectedColor(RGB(FR, FG, FB));
SetSelectedColor(RGBToColor(FR, FG, FB));
end;
procedure TGAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if g <> FG then
CreateGradient;
needNewGradient := g <> FG;
FR := r;
FG := g;
FB := b;
FSelected := c;
FManual := false;
mxx := Round(FB * Width / 255); // BLUE is x
myy := Round((255 - FR) * Height / 255); // RED is y
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end.

62
components/mbColorLib/GColorPicker.pas
View File

@ -50,15 +50,10 @@ begin
FGradientWidth := 256;
FGradientHeight := 1;
FRed := 128;
FGreen := 255;
FBlue := 128;
FArrowPos := ArrowPosFromGreen(255);
FChange := false;
Layout := lyVertical;
SetGreen(255);
Layout := lyVertical;
HintFormat := 'Green: %value (selected)';
FManual := false;
FChange := true;
end;
function TGColorPicker.ArrowPosFromGreen(g: integer): integer;
@ -85,11 +80,11 @@ begin
TBA_Resize:
SetGreen(FGreen);
TBA_MouseMove:
FGreen := GreenFromArrowPos(FArrowPos);
SetGreen(GreenFromArrowPos(FArrowPos));
TBA_MouseDown:
FGreen := GreenFromArrowPos(FArrowPos);
SetGreen(GreenFromArrowPos(FArrowPos));
TBA_MouseUp:
FGreen := GreenFromArrowPos(FArrowPos);
SetGreen(GreenFromArrowPos(FArrowPos));
TBA_WheelUp:
SetGreen(FGreen + Increment);
TBA_WheelDown:
@ -128,10 +123,9 @@ end;
function TGColorPicker.GetSelectedColor: TColor;
begin
if not WebSafe then
Result := RGB(FRed, FGreen, FBlue)
else
Result := GetWebSafe(RGB(FRed, FGreen, FBlue));
Result := RGB(FRed, FGreen, FBlue);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TGColorPicker.GetSelectedValue: integer;
@ -143,10 +137,12 @@ function TGColorPicker.GreenFromArrowPos(p: integer): integer;
var
g: integer;
begin
if Layout = lyHorizontal then
g := Round(p * 255 / (Width - 12))
else
case Layout of
lyHorizontal:
g := Round(p * 255 / (Width - 12));
lyVertical:
g := Round(255 - p * 255 / (Height - 12));
end;
Clamp(g, 0, 255);
Result := g;
end;
@ -157,10 +153,9 @@ begin
if FBlue <> b then
begin
FBlue := b;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -171,9 +166,8 @@ begin
begin
FGreen := g;
FArrowPos := ArrowPosFromGreen(g);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -183,25 +177,33 @@ begin
if FRed <> r then
begin
FRed := r;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TGColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
newGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetRed(GetRValue(c));
SetBlue(GetBValue(c));
SetGreen(GetGValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
newGradient := (r <> FRed) or (b <> FBlue);
FGreen := g;
FBlue := b;
FRed := r;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
end.

78
components/mbColorLib/HColorPicker.pas
View File

@ -13,8 +13,8 @@ uses
type
THColorPicker = class(TmbTrackBarPicker)
private
FVal, FSat, FHue: double;
FMaxVal, FMaxSat, FMaxHue: Integer;
FHue, FSat, FVal: Double;
FMaxHue, FMaxSat, FMaxVal: Integer;
function ArrowPosFromHue(h: integer): integer;
function HueFromArrowPos(p: integer): integer;
function GetHue: Integer;
@ -29,6 +29,8 @@ type
procedure SetSelectedColor(c: TColor);
procedure SetVal(v: integer);
protected
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
function GetGradientColor(AValue: Integer): TColor; override;
@ -39,6 +41,7 @@ type
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
property Value: integer read GetVal write SetVal;
property Layout default lyHorizontal;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxValue: Integer read FMaxVal write SetMaxVal default 255;
@ -59,15 +62,12 @@ begin
FMaxHue := 359;
FMaxSat := 255;
FMaxVal := 255;
FGradientWidth := FMaxHue + 1;
FGradientWidth := FMaxHue;
FGradientHeight := 1;
FSat := 1.0;
FVal := 1.0;
FChange := false;
SetHue(0);
HintFormat := 'Hue: %value (selected)';
FManual := false;
FChange := true;
end;
function THColorPicker.ArrowPosFromHue(h: integer): integer;
@ -88,17 +88,24 @@ begin
Result := a;
end;
function THColorPicker.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
if Layout = lyVertical then WheelDelta := -WheelDelta;
inherited;
end;
procedure THColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
TBA_Resize:
SetHue(GetHue);
TBA_MouseMove:
Hue := HueFromArrowPos(FArrowPos);
SetHue(HueFromArrowPos(FArrowPos));
TBA_MouseDown:
Hue := HueFromArrowPos(FArrowPos);
SetHue(HueFromArrowPos(FArrowPos));
TBA_MouseUp:
Hue := HueFromArrowPos(FArrowPos);
SetHue(HueFromArrowPos(FArrowPos));
TBA_WheelUp:
SetHue(GetHue() + Increment);
TBA_WheelDown:
@ -170,14 +177,16 @@ end;
function THColorPicker.HueFromArrowPos(p: integer): integer;
var
r: integer;
h: integer;
begin
if Layout = lyHorizontal then
r := Round(p / (Width - 12) * FMaxHue)
else
r := Round(p / (Height - 12) * MaxHue);
Clamp(r, 0, FMaxHue);
Result := r;
case Layout of
lyHorizontal:
h := Round(p / (Width - 12) * FMaxHue);
lyVertical:
h := Round(p / (Height - 12) * MaxHue);
end;
Clamp(h, 0, FMaxHue);
Result := h;
end;
procedure THColorPicker.SetHue(h: integer);
@ -187,9 +196,8 @@ begin
begin
FHue := h / FMaxHue;
FArrowPos := ArrowPosFromHue(h);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -201,7 +209,7 @@ begin
FGradientWidth := FMaxHue + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THColorPicker.SetMaxSat(s: Integer);
@ -211,7 +219,7 @@ begin
FMaxSat := s;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THColorPicker.SetMaxVal(v: Integer);
@ -221,7 +229,7 @@ begin
FMaxVal := v;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THColorPicker.SetSat(s: integer);
@ -230,26 +238,31 @@ begin
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure THColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
FChange := false;
SetHue(h);
SetSat(s);
SetVal(v);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
needNewGradient := (s <> FSat) or (v <> FVal);
FHue := h;
FSat := s;
FVal := v;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure THColorPicker.SetVal(v: integer);
@ -258,10 +271,9 @@ begin
if GetVal() <> v then
begin
FVal := v / FMaxVal;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;

123
components/mbColorLib/HRingPicker.pas
View File

@ -13,15 +13,13 @@ uses
type
THRingPicker = class(TmbColorPickerControl)
private
FHue, FSat, FValue: Double;
FMaxHue, FMaxSat, FMaxValue: Integer;
FHue, FSat, FVal: Double;
FMaxHue, FMaxSat, FMaxVal: Integer;
FHueLineColor: TColor;
FSelectedColor: TColor;
FManual: boolean;
mx, my, mdx, mdy: integer;
//FChange: boolean;
FRadius: integer;
FDoChange: boolean;
FDragging: Boolean;
function GetHue: Integer;
function GetSat: Integer;
@ -31,15 +29,15 @@ type
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetRadius(r: integer);
procedure SetValue(v: integer);
procedure SetHue(h: integer);
procedure SetSat(s: integer);
procedure SetValue(v: integer);
procedure SetHueLineColor(c: TColor);
procedure DrawHueLine;
procedure SelectionChanged(x, y: integer);
procedure UpdateCoords;
protected
procedure CreateGradient; override;
procedure DrawHueLine;
function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
@ -60,7 +58,7 @@ type
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 MaxValue: Integer read FMaxVal write SetMaxValue default 255;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property Radius: integer read FRadius write SetRadius default 40;
property SelectedColor default clNone;
@ -81,16 +79,15 @@ begin
SetInitialBounds(0, 0, 204, 204);
FMaxHue := 359;
FMaxSat := 255;
FMaxValue := 255;
FValue := 1.0;
FHue := 0.0;
FMaxVal := 255;
FVal := 1.0;
// FHue := 0.0;
FSat := 1.0;
FHueLineColor := clGray;
FSelectedColor := clNone;
SetSelectedColor(clRed);
// FSelectedColor := clRed; clNone;
FManual := false;
FChange := true;
FRadius := 40;
FDoChange := false;
HintFormat := 'Hue: %h (selected)';
TabStop := true;
end;
@ -137,7 +134,7 @@ begin
else if angle > 360 then
angle := angle - 360;
h := angle / 360;
Result := HSVtoColor(h, FSat, FValue);
Result := HSVtoColor(h, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end
@ -165,7 +162,7 @@ begin
H := 180 * (1 + arctan2(dx, dy) / pi); // wp: order (x,y) is correct!
H := H + 90;
if H > 360 then H := H - 360;
Result := HSVtoColor(H/360, FSat, FValue);
Result := HSVtoColor(H/360, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end else
@ -186,7 +183,7 @@ function THRingPicker.GetSelectedColor: TColor;
begin
if FSelectedColor <> clNone then
begin
Result := HSVtoColor(FHue, FSat, FValue);
Result := HSVtoColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end
@ -196,7 +193,7 @@ end;
function THRingPicker.GetValue: Integer;
begin
Result := round(FValue * FMaxValue);
Result := round(FVal * FMaxVal);
end;
procedure THRingPicker.KeyDown(var Key: Word; Shift: TShiftState);
@ -211,27 +208,14 @@ begin
delta := 1;
case Key of
VK_LEFT:
begin
FChange := false;
SetHue(RadHue(GetHue() + delta));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
begin
FChange := false;
SetHue(RadHue(GetHue() - delta));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end
else
erasekey := false;
VK_LEFT : SetHue(RadHue(GetHue() + delta));
VK_RIGHT : SetHue(RadHue(GetHue() - delta));
else erasekey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
@ -245,9 +229,7 @@ begin
then begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
FDragging := true;
end;
SetFocus;
@ -273,9 +255,7 @@ begin
begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
end;
end;
@ -288,9 +268,7 @@ begin
begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
FDragging := false;
end;
end;
@ -321,11 +299,7 @@ begin
Canvas.Draw(0, 0, FBufferBmp);
DeleteObject(rgn);
DrawHueLine;
if FDoChange then
begin
if Assigned(FOnChange) then FOnChange(Self);
FDoChange := false;
end;
DoChange;
end;
function THRingPicker.RadHue(New: integer): integer;
@ -355,23 +329,17 @@ begin
inc(angle, 360)
else if angle > 360 then
dec(angle, 360);
FChange := false;
SetHue(MulDiv(angle, FMaxHue + 1, 360));
FChange := true;
Invalidate;
end;
procedure THRingPicker.SetHue(h: integer);
begin
if h > FMaxHue then h := h - (FMaxHue + 1);
if h < 0 then h := h + (FMaxHue + 1);
h := RadHue(h);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
FManual := false;
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
@ -391,7 +359,7 @@ begin
FMaxHue := h;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxSat(s: Integer);
@ -401,17 +369,17 @@ begin
FMaxSat := s;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetMaxValue(v: Integer);
begin
if v = FMaxValue then
if v = FMaxVal then
exit;
FMaxValue := v;
FMaxVal := v;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure THRingPicker.SetRadius(r: integer);
@ -429,41 +397,42 @@ begin
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
procedure THRingPicker.SetSelectedColor(c: TColor);
var
changeSave: boolean;
h, s, v: Double;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
changeSave := FChange;
FManual := false;
FChange := false;
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), FHue, FSat, FValue);
FSelectedColor := c;
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
Exit;
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (s <> FSat) or (v <> FVal);
FHue := h;
FSat := s;
FVal := v;
UpdateCoords;
if needNewGradient then
CreateGradient;
Invalidate;
FChange := changeSave;
if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true;
DoChange;
end;
procedure THRingPicker.SetValue(v: integer);
begin
Clamp(v, 0, FMaxValue);
Clamp(v, 0, FMaxVal);
if GetValue() <> V then
begin
FValue := V / FMaxValue;
FManual := false;
FVal := V / FMaxVal;
CreateGradient;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;

192
components/mbColorLib/HSColorPicker.pas
View File

@ -9,7 +9,7 @@ unit HSColorPicker;
interface
uses
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Math, Forms,
LCLIntf, LCLType, SysUtils, Classes, Controls, Graphics, Forms,
RGBHSLUtils, HTMLColors, mbColorPickerControl;
type
@ -18,7 +18,7 @@ type
THSColorPicker = class(TmbColorPickerControl)
private
FHue, FSat, FLum: Double;
FHue, FSat, FLum, FLumSel: Double;
FMaxHue, FMaxSat, FMaxLum: Integer;
dx, dy, mxx, myy: integer;
function GetHue: Integer;
@ -33,24 +33,26 @@ type
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure DrawMarker(x, y: integer);
procedure Paint; override;
function PredictColor: TColor;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
procedure UpdateCoords;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: Integer): TColor; override;
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
function GetSelectedColor: TColor; override;
published
property SelectedColor default clRed;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 240;
property Luminance: Integer read GetLum write SetLum default 120;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
@ -62,7 +64,7 @@ type
implementation
uses
mbUtils;
math, mbUtils;
{THSColorPicker}
@ -75,16 +77,13 @@ begin
FGradientWidth := FMaxHue + 1;
FGradientHeight := FMaxSat + 1;
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
FHue := 0;
FSat := 1.0;
FLum := 0.5;
FLumSel := 0.5;
FSelected := clRed;
FManual := false;
dx := 0;
dy := 0;
mxx := 0;
myy := 0;
CreateGradient;
HintFormat := 'H: %h S: %hslS'#13'Hex: %hex';
MarkerStyle := msCross;
end;
@ -124,33 +123,37 @@ end;
function THSColorPicker.GetColorAtPoint(x, y: Integer): TColor;
var
h, s, l: Double;
H, S: Double;
begin
if InRange(x, 0, Width - 1) and InRange(y, 0, Height - 1) then
begin
h := x / (Width - 1);
s := 1 - y / (Height - 1);
H := x / (Width - 1);
S := 1 - y / (Height - 1);
{$IFDEF USE_COLOR_TO_RGB}
Result := HSLToColor(h, s, FLum);
Result := HSLToColor(H, S, FLumSel);
{$ELSE}
Result := HSLToRGB(h, s, FLum);
Result := HSLToRGB(H, S, FLumSel);
{$ENDIF}
end else
Result := clNone;
end;
function THSColorPicker.GetGradientColor2D(x, y: Integer): TColor;
var
H, S: Double;
begin
H := x / FMaxHue;
S := 1 - y / FMaxSat;
{$IFDEF USE_COLOR_TO_RGB}
Result := HSLToColor(x / FMaxHue, (FBufferBmp.Height - 1 - y) / FMaxSat, FLum);
Result := HSLToColor(H, S, FLum);
{$ELSE}
Result := HSLtoRGB(x / FMaxHue, (FMaxSat - y) / FMaxSat, FLum);
Result := HSLtoRGB(H, S, FLum);
{$ENDIF}
end;
function THSColorPicker.GetHue: Integer;
begin
Result := Round(FHue * FMaxHue);
Result := Round(FHue * (FMaxHue + 1));
end;
function THSColorPicker.GetLum: Integer;
@ -163,16 +166,31 @@ begin
Result := Round(FSat * FMaxSat);
end;
function THSColorPicker.GetSelectedColor: TColor;
begin
{$IFDEF USE_COLOR_TO_RGB}
Result := HSLToColor(FHue, FSat, FLumSel);
{$ELSE}
Result := HSLtoRGB(FHue, FSat, FLumSel);
{$ENDIF}
end;
procedure THSColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then
delta := 10
else
delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
{
case Key of
VK_LEFT:
begin
@ -213,6 +231,7 @@ begin
else
eraseKey := false;
end;
}
if eraseKey then
Key := 0;
@ -223,13 +242,8 @@ end;
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
SelectColor(x, y);
FManual := true;
end;
SetFocus;
end;
@ -237,20 +251,14 @@ procedure THSColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
SelectColor(x, y);
FManual := true;
end;
end;
procedure THSColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
if Button = mbLeft then
SelectColor(x, y);
FManual := true;
end;
end;
procedure THSColorPicker.Paint;
@ -279,9 +287,38 @@ end;
procedure THSColorPicker.SelectColor(x, y: Integer);
var
H, S, L: Double;
c: TColor;
L: Double;
begin
CorrectCoords(x, y);
mxx := x;
myy := y;
c := GetColorAtPoint(x, y);
if WebSafe then c := GetWebSafe(c);
{$IFDEF USE_COLOR_TO_RGB}
ColorToHSL(c, H, S, L);
{$ELSE}
RGBtoHSL(c, H, S, L);
{$ENDIF}
if (H = FHue) and (S = FSat) then
exit;
FHue := H;
FSat := S;
{$IFDEF USE_COLOR_TO_RGB}
FSelected := ColorToHSL(FHue, FSat, FLumSel);
{$ELSE}
FSelected := HSLToRGB(FHue, FSat, FLumSel);
{$ENDIF}
Invalidate;
DoChange;
end;
(*
BeginUpdate;
try
mxx := x;
myy := y;
CorrectCoords(mxx, myy);
@ -295,43 +332,62 @@ begin
FSelected := c;
FManual := false;
Invalidate;
if Assigned(OnChange) then OnChange(Self);
finally
EndUpdate;
end;
end;
*)
procedure THSColorPicker.SetHue(H: integer);
begin
Clamp(H, 0, FMaxHue);
FHue := H / FMaxHue;
if H = GetHue then
exit;
FHue := H / (FMaxHue + 1);
{$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
FSelected := HSLtoColor(FHue, FSat, FLumSel);
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
FSelected := HSLToRGB(FHue, FSat, FLumSel);
{$ENDIF}
UpdateCoords;
Invalidate;
DoChange;
(*
{$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLumSel));
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLumSel));
{$ENDIF}
*)
end;
// Sets the luminance value used for the display. It is not necessarily that
// of the selected color.
// The true luminance of the selected color is given by LumSel
procedure THSColorPicker.SetLum(L: Integer);
begin
Clamp(L, 0, FMaxLum);
if L = GetLum then
exit;
FLum := L / FMaxLum;
CreateGradient;
{$IFDEF USE_COLOR_TO_RGB}
SetSelectedColor(HSLtoColor(FHue, FSat, FLum));
{$ELSE}
SetSelectedColor(HSLToRGB(FHue, FSat, FLum));
{$ENDIF}
Invalidate;
DoChange;
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}
if S = GetSat then
exit;
FSat := S / FMaxSat;
FSelected := HSLToRGB(FHue, FSat, FLumSel);
UpdateCoords;
Invalidate;
DoChange;
end;
procedure THSColorPicker.SetMaxHue(H: Integer);
@ -364,23 +420,41 @@ begin
Invalidate;
end;
// NOTE: In the picker display only the hue and the saturation of the input
// color are used, the luminance is replaced by the preset value of the picker.
// --> The selected color in the üicker display in general is different from the
// input color.
procedure THSColorPicker.SetSelectedColor(c: TColor);
var
L: Double;
H, S, L: Double;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
{$IFDEF USE_COLOR_TO_RGB}
ColorToHSL(c, FHue, FSat, L);
ColorToHSL(c, H, S, L);
{$ELSE}
RGBtoHSL(c, FHue, FSat, L);
RGBtoHSL(c, H, S, L);
{$ENDIF}
FSelected := c;
FManual := false;
if (H = FHue) and (S = FSat) then
exit;
FHue := H;
FSat := S;
FLumSel := L;
UpdateCoords;
Invalidate;
DoChange;
end;
procedure THSCOlorPicker.UpdateCoords;
begin
mxx := Round(FHue * Width);
myy := Round((1.0 - FSat) * Height);
CorrectCoords(mxx, myy);
Invalidate;
if Assigned(OnChange) then OnChange(Self);
end;
end.

64
components/mbColorLib/HSLColorPicker.pas
View File

@ -14,7 +14,6 @@ uses
type
THSLColorPicker = class(TmbBasicPicker)
private
//FOnChange: TNotifyEvent;
FHSPicker: THSColorPicker;
FLPicker: TLColorPicker;
FSelectedColor: TColor;
@ -24,18 +23,16 @@ type
FLumIncrement: integer;
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(H: integer);
procedure SetS(S: integer);
procedure SetL(L: integer);
procedure SetLumIncrement(i: integer);
procedure SetMaxH(H: Integer);
procedure SetMaxS(S: Integer);
procedure SetMaxL(L: Integer);
@ -50,28 +47,28 @@ type
procedure SetLCursor(c: TCursor);
procedure SetSelectedColor(Value: TColor);
protected
procedure DoChange;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
procedure HSPickerChange(Sender: TObject);
procedure LPickerChange(Sender: TObject);
procedure Paint; override;
procedure Resize; override;
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
procedure SelectColor(c: TColor);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetHexColorUnderCursor: string; override;
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
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;
property Red: integer read FRValue write SetR;
property Green: integer read FGValue write SetG;
property Blue: integer read FBValue write SetB;
published
property Hue: integer read GetH write SetH default 0;
property Saturation: integer read GetS write SetS default 240;
property Luminance: integer read GetL write SetL default 120;
property LuminanceIncrement: integer read FLumIncrement write SetLumIncrement default 1;
property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clRed;
property HSPickerPopupMenu: TPopupMenu read FHSMenu write SetHSMenu;
@ -88,12 +85,13 @@ type
property ParentShowHint;
property Anchors;
property Align;
property BorderSpacing;
property Visible;
property Enabled;
property TabOrder;
property Color;
property ParentColor default true;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnChange;
property OnMouseMove;
end;
@ -114,13 +112,12 @@ begin
// PBack.PixelFormat := pf32bit;
SetInitialBounds(0, 0, 206, 146);
TabStop := true;
FSelectedColor := clRed;
FHSPicker := THSColorPicker.Create(Self);
InsertControl(FHSPicker);
FLumIncrement := 1;
FHSCursor := crDefault;
FLCursor := crDefault;
FHSPicker := THSColorPicker.Create(Self);
InsertControl(FHSPicker);
with FHSPicker do
begin
SetInitialBounds(0, 6, 174, 134);
@ -152,9 +149,7 @@ begin
Hue := 0;
Saturation := FHSPicker.MaxLuminance;
Luminance := FHSPicker.MaxLuminance div 2;
FRValue := 255;
FGValue := 0;
FBValue := 0;
FHSHint := 'H: %h S: %hslS'#13'Hex: %hex';
FLHint := 'Luminance: %l';
end;
@ -167,10 +162,11 @@ end;
procedure THSLColorPicker.DoChange;
begin
FRValue := GetRValue(FLPicker.SelectedColor);
FGValue := GetGValue(FLPicker.SelectedColor);
FBValue := GetBValue(FLPicker.SelectedColor);
if Assigned(OnChange) then OnChange(Self);
FSelectedColor := FLPicker.SelectedColor;
FRValue := GetRValue(FSelectedColor);
FGValue := GetGValue(FSelectedColor);
FBValue := GetBValue(FSelectedColor);
inherited;
end;
procedure THSLColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -205,11 +201,6 @@ begin
Result := FLPicker.Luminance;
end;
function THSLColorPicker.GetManual:boolean;
begin
Result := FHSPicker.Manual or FLPicker.Manual;
end;
function THSLColorPicker.GetMaxH: Integer;
begin
Result := FHSPicker.MaxHue;
@ -232,15 +223,15 @@ end;
procedure THSLColorPicker.HSPickerChange(Sender: TObject);
begin
if FHSPicker.Hue <> FLPicker.Hue then
FLPicker.Hue := FHSPicker.Hue;
if FHSPicker.Saturation <> FLPicker.Saturation then
FLPicker.Saturation := FHSPicker.Saturation;
FLPicker.Invalidate;
DoChange;
end;
procedure THSLColorPicker.LPickerChange(Sender: TObject);
begin
FSelectedColor := FLPicker.SelectedColor;
DoChange;
end;
@ -277,6 +268,12 @@ begin
SetSelectedColor(RGB(FRValue, FGValue, FBValue));
end;
procedure THSLColorPicker.SetFocus;
begin
inherited;
FHSPicker.SetFocus;
end;
procedure THSLColorPicker.SetG(G: integer);
begin
FGValue := G;
@ -362,7 +359,9 @@ end;
procedure THSLColorPicker.SetS(S: integer);
begin
if S <> FHSPicker.Saturation then
FHSPicker.Saturation := S;
if S <> FLPicker.Saturation then
FLPicker.Saturation := S;
end;
@ -376,12 +375,13 @@ begin
end;
end;
(*
procedure THSLColorPicker.WMSetFocus(
var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
begin
FHSPicker.SetFocus;
Message.Result := 1;
end;
*)
end.

35
components/mbColorLib/HSLRingPicker.pas
View File

@ -14,7 +14,6 @@ uses
type
THSLRingPicker = class(TmbBasicPicker)
private
//FOnChange: TNotifyEvent;
FRingPicker: THRingPicker;
FSLPicker: TSLColorPicker;
FSelectedColor: TColor;
@ -23,14 +22,12 @@ type
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 SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
@ -48,12 +45,13 @@ type
procedure SetSLCursor(c: TCursor);
protected
procedure CreateWnd; override;
procedure DoChange;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
procedure Paint; override;
procedure Resize; override;
procedure RingPickerChange(Sender: TObject);
procedure SelectColor(c: TColor);
procedure SLPickerChange(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
@ -62,14 +60,13 @@ type
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
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;
property Manual: boolean read GetManual;
property Red: integer read FRValue write SetR;
property Green: integer read FGValue write SetG;
property Blue: integer read FBValue write SetB;
published
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 240;
property Luminance: integer read GetLum write SetLum default 120;
property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
property RingPickerPopupMenu: TPopupMenu read FRingMenu write SetRingMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
@ -166,7 +163,8 @@ begin
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
if Assigned(OnChange) then OnChange(Self);
inherited;
end;
procedure THSLRingPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
@ -201,11 +199,6 @@ begin
Result := FRingPicker.MaxHue;
end;
function THSLRingPicker.GetManual:boolean;
begin
Result := FRingPicker.Manual or FSLPicker.Manual;
end;
function THSLRingPicker.GetMaxSat: Integer;
begin
Result := FSLPicker.MaxSaturation;
@ -259,8 +252,11 @@ procedure THSLRingPicker.RingPickerChange(Sender: TObject);
begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
if FSLPicker.Hue <> FRingPicker.Hue then
begin
FSLPicker.Hue := FRingPicker.Hue;
DoChange;
end;
end;
procedure THSLRingPicker.SelectColor(c: TColor);
@ -376,10 +372,11 @@ end;
procedure THSLRingPicker.SLPickerChange(Sender: TObject);
begin
if FSLPicker = nil then
exit;
if (FSLPicker <> nil) and (FSelectedColor <> FSLPicker.SelectedColor) then
begin
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;
end;
end.

209
components/mbColorLib/HSVColorPicker.pas
View File

@ -20,24 +20,27 @@ type
FShowSatCirc: boolean;
FShowHueLine: boolean;
FShowSelCirc: boolean;
//FChange: boolean;
FDoChange: boolean;
function RadHue(New: integer): integer;
function GetHue: Integer;
function GetSat: Integer;
function GetValue: Integer;
function GetRed: Integer;
function GetGreen: Integer;
function GetBlue: Integer;
procedure SetMaxHue(h: Integer);
procedure SetMaxSat(s: Integer);
procedure SetMaxValue(v: Integer);
procedure SetHue(h: integer);
procedure SetSat(s: integer);
procedure SetValue(V: integer);
procedure SetRed(r: Integer);
procedure SetGreen(g: Integer);
procedure SetBlue(b: Integer);
procedure SetSatCircColor(c: TColor);
procedure SetHueLineColor(c: TColor);
procedure DrawSatCirc;
procedure DrawHueLine;
procedure DrawMarker(x, y: integer);
procedure SelectionChanged(x, y: integer);
procedure SetShowSatCirc(s: boolean);
procedure SetShowSelCirc(s: boolean);
procedure SetShowHueLine(s: boolean);
@ -53,20 +56,24 @@ type
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure SelectColor(x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property Red: Integer read GetRed write SetRed;
property Green: Integer read GetGreen write SetGreen;
property Blue: Integer read GetBlue write SetBlue;
published
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
property Value: integer read GetValue write SetValue;
property SelectedColor default clRed;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 255;
property Value: integer read GetValue write SetValue default 255;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 255;
property MaxValue: Integer read FMaxValue write SetMaxValue default 255;
property SaturationCircleColor: TColor read FSatCircColor write SetSatCircColor default clSilver;
property HueLineColor: TColor read FHueLineColor write SetHueLineColor default clGray;
property SelectedColor default clNone;
property ShowSaturationCircle: boolean read FShowSatCirc write SetShowSatCirc default true;
property ShowHueLine: boolean read FShowHueLine write SetShowHueLine default true;
property ShowSelectionCircle: boolean read FShowSelCirc write SetShowSelCirc default true;
@ -89,17 +96,15 @@ begin
FMaxSat := 255;
FMaxValue := 255;
FHue := 0;
FSat := 0;
FSat := 1.0;
FValue := 1.0;
FSatCircColor := clSilver;
FHueLineColor := clGray;
FSelectedColor := clNone;
FSelectedColor := clRed;
FManual := false;
FShowSatCirc := true;
FShowHueLine := true;
FShowSelCirc := true;
FChange := true;
FDoChange := false;
MarkerStyle := msCrossCirc;
end;
@ -166,6 +171,11 @@ begin
InternalDrawMarker(x, y, c);
end;
function THSVColorPicker.GetBlue: Integer;
begin
Result := GetBValue(FSelectedColor);
end;
function THSVColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
angle: Double;
@ -224,11 +234,21 @@ begin
Result := GetDefaultColor(dctBrush);
end;
function THSVColorPicker.GetGreen: Integer;
begin
Result := GetGValue(FSelectedColor);
end;
function THSVColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function THSVColorPicker.GetRed: Integer;
begin
Result := GetRValue(FSelectedColor);
end;
function THSVColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
@ -257,49 +277,19 @@ var
delta: Integer;
begin
eraseKey := true;
if ssCtrl in shift then
delta := 10
else
delta := 1;
delta := IfThen(ssCtrl in shift, 10, 1);
case Key of
VK_LEFT:
begin
FChange := false;
SetHue(RadHue(GetHue() + delta));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
begin
FChange := false;
SetHue(RadHue(GetHue() - delta));
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_UP:
begin
FChange := false;
SetSat(GetSat() + delta);
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_DOWN:
begin
FChange := false;
SetSat(GetSat() - delta);
FChange := true;
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
else
eraseKey := false;
VK_LEFT : SetHue(RadHue(GetHue() + delta));
VK_RIGHT : SetHue(RadHue(GetHue() - delta));
VK_UP : SetSat(GetSat() + delta);
VK_DOWN : SetSat(GetSat() - delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
@ -310,13 +300,7 @@ begin
if csDesigning in ComponentState then
exit;
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
end;
SelectColor(X, Y);
SetFocus;
end;
@ -326,13 +310,7 @@ begin
if csDesigning in ComponentState then
exit;
if (ssLeft in Shift) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
end;
SelectColor(X, Y);
end;
procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
@ -342,13 +320,7 @@ begin
if csDesigning in ComponentState then
exit;
if (Button = mbLeft) and PointInCircle(Point(x, y), Min(Width, Height)) then
begin
mdx := x;
mdy := y;
FDoChange := true;
SelectionChanged(X, Y);
FManual := true;
end;
SelectColor(X, Y);
end;
procedure THSVColorPicker.Paint;
@ -368,11 +340,6 @@ begin
DrawSatCirc;
DrawHueLine;
DrawMarker(mdx, mdy);
if FDoChange then
begin
if Assigned(FOnChange) then FOnChange(Self);
FDoChange := false;
end;
end;
function THSVColorPicker.RadHue(New: integer): integer;
@ -389,11 +356,15 @@ begin
UpdateCoords;
end;
procedure THSVColorPicker.SelectionChanged(x, y: integer);
procedure THSVColorPicker.SelectColor(x, y: integer);
var
angle: Double;
dx, dy, r, radius: integer;
H, S: Double;
begin
mdx := x;
mdy := y;
radius := Min(Width, Height) div 2;
dx := x - radius;
dy := y - radius;
@ -401,27 +372,53 @@ begin
if r > radius then // point outside circle
begin
FChange := false;
SetSelectedColor(clNone);
FChange := true;
exit;
end;
FSelectedColor := clWhite;
//FSelectedColor := clWhite; // ????
angle := 360 + 180*arctan2(-dy, dx) / pi; // wp: "-y, x" correct? The others have "x, y"
if angle < 0 then
angle := angle + 360
else if angle > 360 then
angle := angle - 360;
FChange := false;
FHue := angle / 360;
H := angle / 360;
if r > radius then
FSat := 1.0
S := 1.0
else
FSat := r / radius;
FChange := true;
S := r / radius;
if (H = FHue) and (S = FSat) then
exit;
FHue := H;
FSat := S;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
UpdateCoords;
Invalidate;
DoChange;
end;
procedure THSVColorPicker.SetBlue(b: Integer);
var
c: TColor;
begin
Clamp(b, 0, 255);
if b = GetBValue(FSelectedColor) then
exit;
c := RgbToColor(GetRValue(FSelectedColor), GetGValue(FSelectedColor), b);
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetGreen(g: Integer);
var
c: TColor;
begin
Clamp(g, 0, 255);
if g = GetGValue(FSelectedColor) then
exit;
c := RgbToColor(GetRValue(FSelectedColor), g, GetBValue(FSelectedColor));
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetHue(h: integer);
@ -431,10 +428,10 @@ begin
if GetHue() <> h then
begin
FHue := h / FMaxHue;
FManual := false;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
@ -453,7 +450,7 @@ begin
exit;
FMaxHue := h;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -463,7 +460,7 @@ begin
exit;
FMaxSat := s;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -473,20 +470,31 @@ begin
exit;
FMaxValue := v;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
procedure THSVColorPicker.SetRed(r: Integer);
var
c: TColor;
begin
Clamp(r, 0, 255);
if r = GetRValue(FSelectedColor) then
exit;
c := RgbToColor(r, GetGValue(FSelectedColor), GetBValue(FSelectedColor));
SetSelectedColor(c);
end;
procedure THSVColorPicker.SetSat(s: integer);
begin
Clamp(s, 0, FMaxSat);
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
@ -501,20 +509,17 @@ 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;
if WebSafe then
c := GetWebSafe(c);
if c = FSelectedColor then
exit;
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;
DoChange;
end;
procedure THSVColorPicker.SetShowHueLine(s: boolean);
@ -550,10 +555,10 @@ begin
if GetValue() <> V then
begin
FValue := V / FMaxValue;
FManual := false;
FSelectedColor := HSVToColor(FHue, FSat, FValue);
CreateGradient;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;

69
components/mbColorLib/KColorPicker.pas
View File

@ -18,11 +18,11 @@ type
function ArrowPosFromBlack(k: integer): integer;
function BlackFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(c: TColor);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
procedure SetBlack(k: integer);
protected
procedure Execute(tbaAction: integer); override;
function GetArrowPos: integer; override;
@ -54,14 +54,9 @@ begin
FCyan := 0;
FMagenta := 0;
FYellow := 0;
FBlack := 255;
FArrowPos := ArrowPosFromBlack(255);
FChange := false;
Layout := lyVertical;
SetBlack(255);
Layout := lyVertical;
HintFormat := 'Black: %value (selected)';
FManual := false;
FChange := true;
end;
function TKColorPicker.ArrowPosFromBlack(k: integer): integer;
@ -87,10 +82,12 @@ function TKColorPicker.BlackFromArrowPos(p: integer): integer;
var
k: integer;
begin
if Layout = lyHorizontal then
k := Round(p/((Width - 12)/255))
else
k := Round(255 - p/((Height - 12)/255));
case Layout of
lyHorizontal:
k := Round(p * 255 / (Width - 12));
lyVertical:
k := Round(255 - p * 255 / (Height - 12));
end;
Clamp(k, 0, 255);
Result := k;
end;
@ -101,11 +98,11 @@ begin
TBA_Resize:
SetBlack(FBlack);
TBA_MouseMove:
FBlack := BlackFromArrowPos(FArrowPos);
SetBlack(BlackFromArrowPos(FArrowPos));
TBA_MouseDown:
FBlack := BlackFromArrowPos(FArrowPos);
SetBlack(BlackFromArrowPos(FArrowPos));
TBA_MouseUp:
FBlack := BlackFromArrowPos(FArrowPos);
SetBlack(BlackFromArrowPos(FArrowPos));
TBA_WheelUp:
SetBlack(FBlack + Increment);
TBA_WheelDown:
@ -160,9 +157,8 @@ begin
begin
FBlack := k;
FArrowPos := ArrowPosFromBlack(k);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -172,10 +168,9 @@ begin
if FCyan <> c then
begin
FCyan := c;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -185,27 +180,32 @@ begin
if FMagenta <> m then
begin
FMagenta := m;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TKColorPicker.SetSelectedColor(c: TColor);
procedure TKColorPicker.SetSelectedColor(clr: TColor);
var
cy, m, y, k: integer;
c, m, y, k: integer;
newGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
ColorToCMYK(c, cy, m, y, k);
FChange := false;
SetMagenta(m);
SetYellow(y);
SetCyan(cy);
SetBlack(k);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
if WebSafe then
clr := GetWebSafe(clr);
if clr = GetSelectedColor then
exit;
ColorToCMYK(clr, c, m, y, k);
newGradient := (c <> FCyan) or (m <> FMagenta) or (y <> FYellow);
FCyan := c;
FMagenta := m;
FYellow := y;
FBlack := k;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TKColorPicker.SetYellow(y: integer);
@ -214,10 +214,9 @@ begin
if FYellow <> y then
begin
FYellow := y;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;

48
components/mbColorLib/LColorPicker.pas
View File

@ -62,11 +62,8 @@ begin
FGradientHeight := 1;
FHue := 0;
FSat := FMaxSat;
FChange := false;
SetLuminance(FMaxLum div 2);
HintFormat := 'Luminance: %value (selected)';
FManual := false;
FChange := true;
end;
function TLColorPicker.ArrowPosFromLum(L: integer): integer;
@ -167,10 +164,10 @@ function TLColorPicker.LumFromArrowPos(p: integer): integer;
var
L: integer;
begin
if Layout = lyHorizontal then
L := Round(p / (Width - 12) * FMaxLum)
else
L := Round(MaxLum - p /(Height - 12) * FMaxLum);
case Layout of
lyHorizontal : L := Round(p / (Width - 12) * FMaxLum);
lyVertical : L := Round(MaxLum - p /(Height - 12) * FMaxLum);
end;
Clamp(L, 0, FMaxLum);
Result := L;
end;
@ -181,10 +178,9 @@ begin
if GetHue() <> H then
begin
FHue := H / FMaxHue;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -195,9 +191,9 @@ begin
begin
FLuminance := L / FMaxLum;
FArrowPos := ArrowPosFromLum(L);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
@ -208,7 +204,7 @@ begin
FMaxHue := H;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TLColorPicker.SetMaxLum(L: Integer);
@ -219,7 +215,7 @@ begin
FGradientWidth := FMaxLum + 1; // 0 .. FMaxHue --> FMaxHue + 1 pixels
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TLColorPicker.SetMaxSat(S: Integer);
@ -229,7 +225,7 @@ begin
FMaxSat := S;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
procedure TLColorPicker.SetSat(S: integer);
@ -238,22 +234,32 @@ begin
if GetSat() <> S then
begin
FSat := S / FMaxSat;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TLColorPicker.SetSelectedColor(c: TColor);
var
H, S, L: Double;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
ColortoHSL(c, FHue, FSat, FLuminance);
FChange := false;
FManual := false;
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
// ColortoHSL(c, FHue, FSat, FLuminance); // not working in HSLPicker
RGBtoHSL(c, H, S, L);
needNewGradient := (H <> FHue) or (S <> FSat);
FHue := H;
FSat := S;
FLuminance := L;
if needNewGradient then
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end.

70
components/mbColorLib/MColorPicker.pas
View File

@ -19,7 +19,7 @@ type
procedure SetBlack(k: integer);
procedure SetCyan(c: integer);
procedure SetMagenta(m: integer);
procedure SetSelectedColor(c: TColor);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
protected
procedure Execute(tbaAction: integer); override;
@ -51,16 +51,11 @@ begin
FGradientWidth := 256;
FGradientHeight := 1;
FCyan := 0;
FMagenta := 255;
FYellow := 0;
FBlack := 0;
FArrowPos := ArrowPosFromMagenta(255);
FChange := false;
Layout := lyVertical;
SetMagenta(255);
Layout := lyVertical;
HintFormat := 'Magenta: %value (selected)';
FManual := false;
FChange := true;
end;
function TMColorPicker.ArrowPosFromMagenta(m: integer): integer;
@ -69,13 +64,12 @@ var
begin
if Layout = lyHorizontal then
begin
a := Round((Width - 12) / 255 * m);
a := Round((Width - 12) * m / 255);
if a > Width - FLimit then a := Width - FLimit;
end
else
begin
m := 255 - m;
a := Round((Height - 12) / 255 * m);
a := Round((Height - 12) * (255 - m) / 255);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
@ -88,11 +82,11 @@ begin
TBA_Resize:
SetMagenta(FMagenta);
TBA_MouseMove:
FMagenta := MagentaFromArrowPos(FArrowPos);
SetMagenta(MagentaFromArrowPos(FArrowPos));
TBA_MouseDown:
FMagenta := MagentaFromArrowPos(FArrowPos);
SetMagenta(MagentaFromArrowPos(FArrowPos));
TBA_MouseUp:
FMagenta := MagentaFromArrowPos(FArrowPos);
SetMagenta(MagentaFromArrowPos(FArrowPos));
TBA_WheelUp:
SetMagenta(FMagenta + Increment);
TBA_WheelDown:
@ -144,10 +138,12 @@ function TMColorPicker.MagentaFromArrowPos(p: integer): integer;
var
m: integer;
begin
if Layout = lyHorizontal then
m := Round(p * 255 / (Width - 12))
else
case Layout of
lyHorizontal:
m := Round(p * 255 / (Width - 12));
lyVertical:
m := Round(255 - p * 255 / (Height - 12));
end;
Clamp(m, 0, 255);
Result := m;
end;
@ -158,10 +154,9 @@ begin
if FBlack <> k then
begin
FBlack := k;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -171,10 +166,9 @@ begin
if FCyan <> c then
begin
FCyan := c;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -185,26 +179,31 @@ begin
begin
FMagenta := m;
FArrowPos := ArrowPosFromMagenta(m);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TMColorPicker.SetSelectedColor(c: TColor);
procedure TMColorPicker.SetSelectedColor(clr: TColor);
var
cy, m, y, k: integer;
c, m, y, k: integer;
newGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
ColorToCMYK(c, cy, m, y, k);
FChange := false;
SetCyan(cy);
SetYellow(y);
SetBlack(k);
SetMagenta(m);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
if WebSafe then
clr := GetWebSafe(clr);
if clr = GetSelectedColor then
exit;
ColorToCMYK(clr, c, m, y, k);
newGradient := (c <> FCyan) or (y <> FYellow) or (k <> FBlack);
FCyan := c;
FMagenta := m;
FYellow := y;
FBlack := k;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TMColorPicker.SetYellow(y: integer);
@ -213,10 +212,9 @@ begin
if FYellow <> y then
begin
FYellow := y;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;

42
components/mbColorLib/OfficeMoreColorsDialog.lfm
View File

@ -23,7 +23,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideBottom.Control = NewSwatch
Left = 290
Height = 15
Top = 209
Top = 213
Width = 24
Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4
@ -200,6 +200,8 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 141
Top = 0
Width = 232
Hue = 180
Saturation = 227
SelectedColor = 16315911
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
LPickerHintFormat = 'Luminance: %l'
@ -216,6 +218,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Height = 124
Top = 0
Width = 136
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
ParentShowHint = False
@ -235,14 +238,17 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
object nbSLH: TPage
object SLH: TSLHColorPicker
Left = 0
Height = 122
Height = 141
Top = 0
Width = 238
Width = 232
ParentColor = False
Luminance = 240
HPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %hslS L: %l'#13'Hex: %hex'
ParentShowHint = False
Align = alClient
TabOrder = 0
Color = clMenuHighlight
OnChange = ColorPickerChange
end
end
@ -253,7 +259,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Left = 14
Height = 32
Top = 0
Width = 206
Width = 218
HintFormat = 'Red: %value (selected)'
Layout = lyHorizontal
SelectionIndicator = siRect
@ -270,7 +276,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Left = 16
Height = 32
Top = 40
Width = 204
Width = 216
BevelInner = bvLowered
BevelOuter = bvRaised
HintFormat = 'Green: %value (selected)'
@ -289,7 +295,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Left = 16
Height = 32
Top = 80
Width = 204
Width = 216
HintFormat = 'Blue: %value (selected)'
Layout = lyHorizontal
SelectionIndicator = siRect
@ -305,8 +311,8 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = RTrackbar
Left = 4
Height = 13
Top = 10
Height = 15
Top = 9
Width = 7
Anchors = [akTop, akRight]
BorderSpacing.Right = 3
@ -317,10 +323,10 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideTop.Control = GTrackbar
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = GTrackbar
Left = 4
Height = 13
Top = 50
Width = 7
Left = 3
Height = 15
Top = 49
Width = 8
Anchors = [akTop, akRight]
BorderSpacing.Left = 4
BorderSpacing.Right = 5
@ -331,10 +337,10 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
AnchorSideTop.Control = BTrackbar
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = BTrackbar
Left = 5
Height = 13
Top = 90
Width = 6
Left = 4
Height = 15
Top = 89
Width = 7
Anchors = [akTop, akRight]
BorderSpacing.Left = 4
BorderSpacing.Right = 5
@ -379,7 +385,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Left = 266
Height = 32
Hint = 'RGB(255, 255, 255)'
Top = 228
Top = 232
Width = 73
Anchors = [akLeft, akBottom]
ShowHint = True
@ -395,7 +401,7 @@ object OfficeMoreColorsWin: TOfficeMoreColorsWin
Left = 266
Height = 32
Hint = 'RGB(255, 255, 255)'#13#10'Hex: FFFFFF'
Top = 260
Top = 264
Width = 73
Anchors = [akLeft, akRight, akBottom]
ShowHint = True

68
components/mbColorLib/OfficeMoreColorsDialog.pas
View File

@ -100,8 +100,6 @@ implementation
procedure TOfficeMoreColorsWin.ColorPickerChange(Sender: TObject);
begin
if FLockChange <> 0 then
exit;
if Sender = HSL then
SetAllCustom(HSL.SelectedColor);
if Sender = HSLRing then
@ -127,10 +125,6 @@ procedure TOfficeMoreColorsWin.cbColorDisplayChange(Sender: TObject);
begin
PickerNotebook.PageIndex := cbColorDisplay.ItemIndex;
SetAllCustom(NewSwatch.Color);
exit;
{
HSL.Visible := cbColorDisplay.ItemIndex = 0;
HSLRing.Visible := cbColorDisplay.ItemIndex = 1;
@ -146,73 +140,91 @@ end;
procedure TOfficeMoreColorsWin.EBlueChange(Sender: TObject);
begin
if (EBlue.Text <> '') and EBlue.Focused then
if (EBlue.Text <> '') and EBlue.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Blue := EBlue.Value;
SLH.Blue := EBlue.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.EGreenChange(Sender: TObject);
begin
if (EGreen.Text <> '') and EGreen.Focused then
if (EGreen.Text <> '') and EGreen.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Green := EGreen.Value;
SLH.Green := EGreen.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.EHueChange(Sender: TObject);
begin
if (EHue.Text <> '') and EHue.Focused then
if (EHue.Text <> '') and EHue.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Hue := EHue.Value;
SLH.Hue := EHue.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.ELumChange(Sender: TObject);
begin
if (ELum.Text <> '') and ELum.Focused then
if (ELum.Text <> '') and ELum.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Luminance := ELum.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.ERedChange(Sender: TObject);
begin
if (ERed.Text <> '') and ERed.Focused then
if (ERed.Text <> '') and ERed.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Red := ERed.Value;
SLH.Red := ERed.Value;
NewSwatch.Color := RGB(ERed.Value, EGreen.Value, EBlue.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.ESatChange(Sender: TObject);
begin
if (ESat.Text <> '') and ESat.Focused then
if (ESat.Text <> '') and ESat.Focused and (FLockChange = 0) then
begin
inc(FLockChange);
try
HSL.Saturation := ESat.Value;
SLH.Saturation := ESat.Value;
NewSwatch.Color := HSLRangeToRGB(EHue.Value, ESat.Value, ELum.Value);
finally
dec(FLockChange);
end;
end;
end;
procedure TOfficeMoreColorsWin.FormCreate(Sender: TObject);
@ -392,15 +404,11 @@ end;
procedure TOfficeMoreColorsWin.HSLChange(Sender: TObject);
begin
if FLockChange <> 0 then
exit;
SetAllCustom(HSL.SelectedColor);
end;
procedure TOfficeMoreColorsWin.HSLRingChange(Sender: TObject);
begin
if FLockChange <> 0 then
exit;
SetAllCustom(HSLRing.SelectedColor);
end;
@ -411,7 +419,7 @@ var
begin
NewSwatch.Hint := GetHint(NewSwatch.Color);
if (ERed = nil) or (EBlue = nil) or (EGreen = nil) or
(EHue = nil) or (ESat = nil) or (ELum = nil) or (FLockChange <> 0)
(EHue = nil) or (ESat = nil) or (ELum = nil)
then
exit;
@ -432,21 +440,24 @@ end;
procedure TOfficeMoreColorsWin.SetAllCustom(c: TColor);
var
r, g, b: Integer;
h, s, l: Integer;
H, S, L: Double;
// h, s, l: Integer;
begin
if (ERed = nil) or (EGreen = nil) or (EBlue = nil) or
(EHue = nil) or (ESat = nil) or (ELum = nil) or
(PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil)
(PickerNotebook = nil) or (HSL = nil) or (HSLRing = nil) or (SLH = nil) or
(FLockChange > 0)
then
exit;
inc(FLockChange);
try
NewSwatch.Color := c;
// inc(FLockChange);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
RGBtoHSLRange(c, h, s, l);
RGBToHSL(c, H, S, L);
// RGBtoHSLRange(c, h, s, l);
if PickerNotebook.ActivePage = nbHSL.Name then
HSL.SelectedColor := c
@ -469,12 +480,11 @@ begin
ERed.Value := r;
EGreen.Value := g;
EBlue.Value := b;
EHue.Value := h;
ESat.Value := s;
ELum.Value := l;
finally
dec(FLockChange);
end;
EHue.Value := H * HSL.MaxHue;
ESat.Value := S * HSL.MaxSaturation;
ELum.Value := L * HSL.MaxLuminance;
// dec(FLockChange);
end;
procedure TOfficeMoreColorsWin.SetAllToSel(c: TColor);
@ -501,8 +511,6 @@ end;
procedure TOfficeMoreColorsWin.SLHChange(Sender: TObject);
begin
if FLockChange <> 0 then
exit;
SetAllCustom(SLH.SelectedColor);
end;

135
components/mbColorLib/RAxisColorPicker.pas
View File

@ -27,6 +27,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(x, y: Integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
@ -44,7 +45,7 @@ type
implementation
uses
mbUtils;
Math, mbUtils;
{TRAxisColorPicker}
@ -117,58 +118,18 @@ var
eraseKey: Boolean;
begin
eraseKey := true;
if ssCtrl in Shift then
delta := 10
else
delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT:
begin
mxx := dx - delta;
if mxx < 0 then mxx := 0;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_RIGHT:
begin
mxx := dx + delta;
if mxx >= Width then mxx := Width - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
if myy < 0 then myy := 0;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
if myy >= Height then
myy := Height - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
else
eraseKey := false;
VK_LEFT : SelectColor(mxx - delta, myy);
VK_RIGHT : SelectColor(mxx + delta, myy);
VK_UP : SelectColor(mxx, myy - delta);
VK_DOWN : SelectColor(mxx, myy + delta);
else eraseKey := false;
end;
if eraseKey then Key := 0;
if eraseKey then
Key := 0;
inherited;
end;
@ -176,17 +137,8 @@ end;
procedure TRAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
mxx := x;
myy := y;
if Button = mbLeft then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SelectColor(x, y);
SetFocus;
end;
@ -194,33 +146,15 @@ procedure TRAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
SelectColor(x, y);
end;
procedure TRAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
Clamp(mxx, 0, Width - 1);
Clamp(myy, 0, Height - 1);
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
if Button = mbLeft then
SelectColor(x, y);
end;
procedure TRAxisColorPicker.Paint;
@ -237,6 +171,32 @@ begin
inherited;
end;
procedure TRAxisColorPicker.SelectColor(x, y: Integer);
var
c: TColor;
r, g, b: Integer;
needNewGradient: Boolean;
begin
CorrectCoords(x, y);
mxx := x;
myy := y;
c := GetColorAtPoint(x, y);
if c = FSelected then
exit;
FSelected := c;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
needNewGradient := r <> FR;
FR := r;
FG := g;
FB := b;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TRAxisColorPicker.SetBValue(b: integer);
begin
Clamp(b, 0, 255);
@ -257,7 +217,6 @@ begin
if FR <> r then
begin
FR := r;
CreateGradient;
SetSelectedColor(RGBtoColor(FR, FG, FB));
end;
end;
@ -265,13 +224,17 @@ end;
procedure TRAxisColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = FSelected then
exit;
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
if r <> FR then
CreateGradient;
needNewGradient := r <> FR;
FR := r;
FG := g;
FB := b;
@ -279,8 +242,10 @@ begin
FManual := false;
mxx := Round(FB * Width / 255); // BLUE on x
myy := Round((255 - FG) * Height / 255); // GREEN on y
if needNewGradient then
CreateGradient;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
DoChange;
end;
end.

64
components/mbColorLib/RColorPicker.pas
View File

@ -50,16 +50,11 @@ begin
inherited;
FGradientWidth := 256;
FGradientHeight := 1;
FRed := 255;
FGreen := 128;
FBlue := 128;
FArrowPos := ArrowPosFromRed(255);
FChange := false;
Layout := lyVertical;
SetRed(255);
Layout := lyVertical;
HintFormat := 'Red: %value (selected)';
FManual := false;
FChange := true;
end;
function TRColorPicker.ArrowPosFromRed(r: integer): integer;
@ -68,7 +63,7 @@ var
begin
if Layout = lyHorizontal then
begin
a := Round((Width - 12) / 255 * r);
a := Round((Width - 12) * r / 255);
if a > Width - FLimit then a := Width - FLimit;
end
else
@ -86,11 +81,11 @@ begin
TBA_Resize:
SetRed(FRed);
TBA_MouseMove:
FRed := RedFromArrowPos(FArrowPos);
SetRed(RedFromArrowPos(FArrowPos));
TBA_MouseDown:
FRed := RedFromArrowPos(FArrowPos);
SetRed(RedFromArrowPos(FArrowPos));
TBA_MouseUp:
FRed := RedFromArrowPos(FArrowPos);
SetRed(RedFromArrowPos(FArrowPos));
TBA_WheelUp:
SetRed(FRed + Increment);
TBA_WheelDown:
@ -129,10 +124,9 @@ end;
function TRColorPicker.GetSelectedColor: TColor;
begin
if not WebSafe then
Result := RGB(FRed, FGreen, FBlue)
else
Result := GetWebSafe(RGB(FRed, FGreen, FBlue));
Result := RGB(FRed, FGreen, FBlue);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TRColorPicker.GetSelectedValue: integer;
@ -144,10 +138,10 @@ function TRColorPicker.RedFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p * 255 / (Width - 12))
else
r := Round(255 - p * 255 / (Height - 12));
case Layout of
lyHorizontal : r := Round(p * 255 / (Width - 12));
lyVertical : r := Round(255 - p * 255 / (Height - 12));
end;
Clamp(r, 0, 255);
Result := r;
end;
@ -158,10 +152,9 @@ begin
if FBlue <> b then
begin
FBlue := b;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -171,10 +164,9 @@ begin
if FGreen <> g then
begin
FGreen := g;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -185,24 +177,32 @@ begin
begin
FRed := r;
FArrowPos := ArrowPosFromRed(r);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TRColorPicker.SetSelectedColor(c: TColor);
var
r, g, b: Integer;
newGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
FChange := false;
SetGreen(GetGValue(c));
SetBlue(GetBValue(c));
SetRed(GetRValue(c));
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(self);
r := GetRValue(c);
g := GetGValue(c);
b := GetBValue(c);
newGradient := (g <> FGreen) or (b <> FBlue);
FGreen := g;
FBlue := b;
FRed := r;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
end.

9
components/mbColorLib/RGBHSLUtils.pas
View File

@ -131,6 +131,11 @@ var
var
V : double;
begin
if Hue > 10 then
Hue := Hue + 1;
if Hue < 0 then
Hue := Hue + 1
else if Hue > 1 then
@ -143,7 +148,7 @@ var
V := M1 + (M2 - M1) * (2/3 - Hue) * 6
else
V := M1;
Result := round (255 * V)
Result := round(255 * V)
end;
var
@ -151,7 +156,7 @@ var
begin
if S = 0 then
begin
R := round(MaxLum * L);
R := round(255 * L);
G := R;
B := R
end

118
components/mbColorLib/RGBHSVUtils.pas
View File

@ -10,17 +10,20 @@ uses
LCLIntf, LCLType, SysUtils, Classes, Graphics, Math,
Scanlines;
{ The next four procedures assume H, S, V to be in the range 0..1 }
procedure ColorToHSV(c: TColor; out H, S, V: Double);
procedure RGBtoHSV(R, G, B: Integer; out H, S, V: Double);
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer);
function HSVtoRGBTriple(H, S, V: integer): TRGBTriple;
function HSVtoRGBQuad(H, S, V: integer): TRGBQuad;
function HSVtoColor(H, S, V: Double): TColor;
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
{ These next procedure assume H to be in the range 0..360
and S, V in the range 0..255 }
procedure RGBtoHSVRange(R, G, B: integer; out H, S, V: integer);
procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer);
function HSVRangeToColor(H, S, V: Integer): TColor;
function HSVtoRGBTriple(H, S, V: integer): TRGBTriple;
function HSVtoRGBQuad(H, S, V: integer): TRGBQuad;
function GetHValue(Color: TColor): integer;
function GetVValue(Color: TColor): integer;
@ -29,6 +32,87 @@ function GetSValue(Color: TColor): integer;
implementation
{ Assumes R, G, B to be in range 0..255. Calculates H, S, V in range 0..1
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c }
procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
var
rr, gg, bb: Double;
cmax, cmin, delta: Double;
begin
rr := R / 255;
gg := G / 255;
bb := B / 255;
cmax := MaxValue([rr, gg, bb]);
cmin := MinValue([rr, gg, bb]);
delta := cmax - cmin;
if delta = 0 then
begin
H := 0;
S := 0;
end else
begin
if cmax = rr then
H := (gg - bb) / delta + IfThen(gg < bb, 6, 0)
else if cmax = gg then
H := (bb - rr) / delta + 2
else if (cmax = bb) then
H := (rr -gg) / delta + 4;
H := H / 6;
S := delta / cmax;
end;
V := cmax;
end;
procedure ColorToHSV(c: TColor; out H, S, V: Double);
begin
RGBToHSV(GetRValue(c), GetGValue(c), GetBValue(c), H, S, V);
end;
{ Assumes H, S, V in the range 0..1 and calculates the R, G, B values which are
returned to be in the range 0..255.
From: http://axonflux.com/handy-rgb-to-hsl-and-rgb-to-hsv-color-model-c
}
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
var
i: Integer;
f: Double;
p, q, t: Double;
procedure MakeRgb(rr, gg, bb: Double);
begin
R := Round(rr * 255);
G := Round(gg * 255);
B := Round(bb * 255);
end;
begin
i := floor(H * 6);
f := H * 6 - i;
p := V * (1 - S);
q := V * (1 - f*S);
t := V * (1 - (1 - f) * S);
case i mod 6 of
0: MakeRGB(V, t, p);
1: MakeRGB(q, V, p);
2: MakeRGB(p, V, t);
3: MakeRGB(p, q, V);
4: MakeRGB(t, p, V);
5: MakeRGB(V, p, q);
else MakeRGB(0, 0, 0);
end;
end;
function HSVToColor(H, S, V: Double): TColor;
var
r, g, b: Integer;
begin
HSVtoRGB(H, S, V, r, g, b);
Result := RgbToColor(r, g, b);
end;
//------------------------------------------------------------------------------
procedure RGBToHSVRange(R, G, B: integer; out H, S, V: integer);
var
Delta, Min, H1, S1: double;
@ -55,21 +139,6 @@ begin
s := round(s1*255);
end;
procedure RGBToHSV(R, G, B: Integer; out H, S, V: Double);
var
hh, ss, vv: Integer;
begin
RGBtoHSVRange(R, G, B, hh, ss, vv);
H := H / 360;
S := S / 255;
V := V / 255;
end;
procedure HSVtoRGB(H, S, V: Double; out R, G, B: Integer);
begin
HSVtoRGBRange(round(H*360), round(S*255), round(V*255), R, G, B);
end;
procedure HSVtoRGBRange(H, S, V: Integer; out R, G, B: Integer);
var
t: TRGBTriple;
@ -147,10 +216,7 @@ begin
Result := RGBTripleToColor(HSVtoRGBTriple(H, S, V));
end;
function HSVtoColor(H, S, V: Double): TColor;
begin
Result := HSVRangeToColor(round(H*360), round(S*255), round(V*255));
end;
//------------------------------------------------------------------------------
function GetHValue(Color: TColor): integer;
var

104
components/mbColorLib/SColorPicker.pas
View File

@ -62,13 +62,10 @@ begin
FMaxVal := 255;
FGradientWidth := FMaxSat + 1;
FGradientHeight := 1;
FChange := false;
FHue := 0;
FVal := 1.0;
SetSat(FMaxSat);
HintFormat := 'Saturation: %value (selected)';
FManual := false;
FChange := true;
end;
function TSColorPicker.ArrowPosFromSat(s: integer): integer;
@ -82,60 +79,13 @@ begin
end
else
begin
s := FMaxSat - s;
a := Round(s / FMaxSat * (Height - 12));
a := Round((FMaxSat - s) / FMaxSat * (Height - 12));
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
(*
procedure TSColorPicker.CreateSGradient;
var
i,j: integer;
row: pRGBQuadArray;
begin
if FSBmp = nil then
begin
FSBmp := TBitmap.Create;
FSBmp.PixelFormat := pf32bit;
end;
if Layout = lyHorizontal then
begin
FSBmp.width := 255;
FSBmp.height := 12;
for i := 0 to 254 do
for j := 0 to 11 do
begin
row := FSBmp.Scanline[j];
if not WebSafe then
row[i] := RGBToRGBQuad(HSVtoColor(FHue, i, FVal))
// FSBmp.Canvas.Pixels[i, j] := HSVtoColor(FHue, i, FVal)
else
row[i] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, i, FVal)));
// FSBmp.Canvas.Pixels[i, j] := GetWebSafe(HSVtoColor(FHue, i, FVal));
end;
end
else
begin
FSBmp.width := 12;
FSBmp.height := 255;
for i := 0 to 254 do
begin
row := FSBmp.Scanline[i];
for j := 0 to 11 do
if not WebSafe then
row[j] := RGBToRGBQuad(HSVtoColor(FHue, 255-i, FVal))
// FSBmp.Canvas.Pixels[j, i] := HSVtoColor(FHue, 255-i, FVal)
else
row[j] := RGBToRGBQuad(GetWebSafe(HSVtoColor(FHue, 255-i, FVal)));
// FSBmp.Canvas.Pixels[j, i] := GetWebSafe(HSVtoColor(FHue, 255-i, FVal));
end;
end;
end;
*)
procedure TSColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
@ -214,14 +164,14 @@ end;
function TSColorPicker.SatFromArrowPos(p: integer): integer;
var
r: integer;
s: integer;
begin
if Layout = lyHorizontal then
r := Round(p / (Width - 12) * FMaxSat)
else
r := Round(FMaxSat - p / (Height - 12) * FMaxSat);
Clamp(r, 0, FMaxSat);
Result := r;
case Layout of
lyHorizontal: s := Round(p / (Width - 12) * FMaxSat);
lyVertical : s := Round(FMaxSat - p / (Height - 12) * FMaxSat);
end;
Clamp(s, 0, FMaxSat);
Result := s;
end;
procedure TSColorPicker.SetMaxHue(h: Integer);
@ -230,7 +180,7 @@ begin
exit;
FMaxHue := h;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -241,7 +191,7 @@ begin
FMaxSat := s;
FGradientWidth := FMaxSat + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -251,7 +201,7 @@ begin
exit;
FMaxVal := v;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -262,9 +212,8 @@ begin
begin
FHue := h / FMaxHue;
CreateGradient;
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -274,26 +223,31 @@ begin
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
FArrowPos := ArrowPosFromSat(s);
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
procedure TSColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
FChange := false;
SetHue(h);
SetSat(s);
SetValue(v);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
needNewGradient := (h <> FHue) or (v <> FVal);
FHue := h;
FSat := s;
FVal := v;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TSColorPicker.SetValue(v: integer);
@ -302,12 +256,10 @@ begin
if GetVal() <> v then
begin
FVal := v / FMaxVal;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
end.

178
components/mbColorLib/SLColorPicker.pas
View File

@ -6,7 +6,7 @@ interface
uses
LCLIntf, LCLType, LMessages,
SysUtils, Classes, Controls, Graphics, Math, Forms,
SysUtils, Classes, Controls, Graphics, Forms,
mbColorPickerControl;
type
@ -14,38 +14,37 @@ type
private
FHue, FSat, FLum: Double;
FMaxHue, FMaxSat, FMaxLum: integer;
//FChange: boolean;
procedure DrawMarker(x, y: integer);
procedure SelectionChanged(x, y: integer);
procedure UpdateCoords;
function GetHue: Integer;
function GetLum: Integer;
function GetSat: Integer;
procedure SetHue(H: integer);
procedure SetSat(S: integer);
procedure SetLum(L: integer);
procedure SetSat(S: integer);
procedure SetMaxHue(H: Integer);
procedure SetMaxLum(L: Integer);
procedure SetMaxSat(S: Integer);
procedure UpdateCoords;
protected
function GetGradientColor2D(X, Y: Integer): TColor; override;
function GetSelectedColor: TColor; override;
procedure SetSelectedColor(c: TColor); override;
procedure Paint; override;
procedure Resize; override;
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
function GetGradientColor2D(X, Y: Integer): TColor; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Resize; override;
procedure Paint; override;
procedure SelectColor(x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
property ColorUnderCursor;
published
property Hue: integer read GetHue write SetHue;
property Saturation: integer read GetSat write SetSat;
property Luminance: integer read GetLum write SetLum;
property Hue: integer read GetHue write SetHue default 0;
property Saturation: integer read GetSat write SetSat default 0;
property Luminance: integer read GetLum write SetLum default 240;
property MaxHue: Integer read FMaxHue write SetMaxHue default 359;
property MaxSaturation: Integer read FMaxSat write SetMaxSat default 240;
property MaxLuminance: Integer read FMaxLum write SetMaxLum default 240;
@ -57,6 +56,7 @@ type
implementation
uses
Math,
ScanLines, RGBHSLUtils, HTMLColors, mbUtils;
{ TSLColorPicker }
@ -70,13 +70,18 @@ begin
FGradientWidth := FMaxSat + 1; // x --> Saturation
FGradientHeight := FMaxLum + 1; // y --> Luminance
SetInitialBounds(0, 0, FGradientWidth, FGradientHeight);
FHue := 0.0;
FSat := 0.0;
FLum := 1.0;
FChange := true;
FSelected := clWhite;
RGBToHSL(FSelected, FHue, FSat, FLum);
HintFormat := 'S: %hslS L: %l'#13'Hex: %hex';
MarkerStyle := msCircle;
end;
procedure TSLColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
procedure TSLColorPicker.CreateWnd;
begin
inherited;
@ -93,17 +98,25 @@ begin
end;
function TSLColorPicker.GetColorAtPoint(x, y: integer): TColor;
var
S, L: Double;
begin
Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1));
S := x / (Width - 1);
L := 1.0 - y / (Height - 1);
Result := HSLToRGB(FHue, S, L);
// Result := HSLToRGB(FHue, x/(Width - 1), (Height - 1 - y) / (Height - 1));
if WebSafe then
Result := GetWebSafe(Result);
end;
{ This picker has Saturation along the X and Luminance along the Y axis. }
{ This picker has Saturation along the X and Luminance along the Y axis.
NOTE: The HSL conversion (HSLtoColor) seems to be wrong
but it produces the display seen elsewhere }
function TSLColorPicker.GetGradientColor2D(X, Y: Integer): TColor;
begin
Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum);
// Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum);
// Result := HSLtoColor(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // wrong formula
Result := HSLtoRGB(FHue, x / FMaxSat, (FMaxLum - y) / FMaxLum); // correct, but looks wrong...
end;
function TSLColorPicker.GetHue: Integer;
@ -121,24 +134,22 @@ begin
Result := round(FSat * FMaxSat);
end;
function TSLColorPicker.GetSelectedColor: TColor;
begin
Result := HSLtoRGB(FHue, FSat, FLum);
if WebSafe then
Result := GetWebSafe(Result);
end;
procedure TSLColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if ssCtrl in Shift then
delta := 10
else
delta := 1;
delta := IfThen(ssCtrl in Shift, 10, 1);
case Key of
VK_LEFT : SelectColor(mdx - delta, mdy);
VK_RIGHT : SelectColor(mdx + delta, mdy);
VK_UP : SelectColor(mdx, mdy - delta);
VK_DOWN : SelectColor(mdx, mdy + delta);
else eraseKey := false;
end;
{
case Key of
VK_LEFT:
if (mdx - delta >= 0) then
@ -146,7 +157,7 @@ begin
Dec(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
VK_RIGHT:
if (mdx + delta < Width) then
@ -154,7 +165,7 @@ begin
Inc(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
VK_UP:
if (mdy - delta >= 0) then
@ -162,7 +173,7 @@ begin
Dec(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
VK_DOWN:
if (mdy + delta < Height) then
@ -170,11 +181,12 @@ begin
Inc(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
else
eraseKey := false;
end;
}
if eraseKey then
Key := 0;
@ -188,12 +200,8 @@ begin
inherited;
if csDesigning in ComponentState then
Exit;
if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
end;
if (Button = mbLeft) then
SelectColor(X, Y);
SetFocus;
end;
@ -202,27 +210,18 @@ begin
inherited;
if csDesigning in ComponentState then
Exit;
if (ssLeft in Shift) and PtInRect(ClientRect, Point(x, y)) then
begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
end;
if (ssLeft in Shift) then
SelectColor(X, Y);
end;
procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited;
if csDesigning in ComponentState then Exit;
if (Button = mbLeft) and PtInRect(ClientRect, Point(x, y)) then
begin
mdx := x;
mdy := y;
SelectionChanged(X, Y);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
if csDesigning in ComponentState then
Exit;
if (Button = mbLeft)then
SelectColor(X, Y);
end;
procedure TSLColorPicker.Paint;
@ -238,16 +237,22 @@ begin
UpdateCoords;
end;
procedure TSLColorPicker.SelectionChanged(x, y: integer);
procedure TSLColorPicker.SelectColor(x, y: integer);
var
S, L: Double;
begin
FChange := false;
FSat := x / (Width - 1);
FLum := (Height - y - 1) / (Height - 1);
FManual := false;
UpdateCoords;
CorrectCoords(x, y);
S := x / (Width - 1);
L := 1 - y / (Height - 1);
if (S = FSat) and (L = FLum) then
exit;
FSat := S;
FLum := L;
FSelected := HSLtoRGB(FHue, FSat, FLum);
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true;
UpdateCoords;
DoChange;
end;
procedure TSLColorPicker.SetHue(H: integer);
@ -256,11 +261,11 @@ begin
if GetHue() <> H then
begin
FHue := h / FMaxHue;
FManual := false;
FSelected := HSLtoRGB(FHue, FSat, FLum);
CreateGradient;
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
@ -270,10 +275,10 @@ begin
if GetLum() <> L then
begin
FLum := L / FMaxLum;
FManual := false;
FSelected := HSLtoRGB(FHue, FSat, FLum);
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
@ -283,7 +288,7 @@ begin
exit;
FMaxHue := H;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -294,7 +299,7 @@ begin
FMaxLum := L;
FGradientHeight := FMaxLum + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -305,7 +310,7 @@ begin
FMaxSat := S;
FGradientWidth := FMaxSat + 1;
CreateGradient;
if FChange and Assigned(OnChange) then OnChange(Self);
//if FChange and Assigned(OnChange) then OnChange(Self);
Invalidate;
end;
@ -315,26 +320,35 @@ begin
if GetSat() <> S then
begin
FSat := S / FMaxSat;
FManual := false;
FSelected := HSLtoRGB(FHue, FSat, FLum);
UpdateCoords;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
DoChange;
end;
end;
procedure TSLColorPicker.SetSelectedColor(c: TColor);
var
h, s, l: Double;
H, S, L: Double;
needNewGradient: Boolean;
begin
if WebSafe then c := GetWebSafe(c);
FManual := false;
FChange := false;
ColorToHSL(c, FHue, FSat, FLum);
FManual := false;
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
RGBToHSL(c, H, S, L);
// ColorToHSL(c, H, S, L);
needNewGradient := (FHue <> H);
FHue := H;
FSat := S;
FLum := L;
FSelected := c;
UpdateCoords;
if needNewGradient then
CreateGradient;
Invalidate;
if FChange and Assigned(FOnChange) then FOnChange(Self);
FChange := true;
DoChange;
end;
procedure TSLColorPicker.UpdateCoords;

59
components/mbColorLib/SLHColorPicker.pas
View File

@ -12,7 +12,6 @@ uses
type
TSLHColorPicker = class(TmbBasicPicker)
private
//FOnChange: TNotifyEvent;
FSLPicker: TSLColorPicker;
FHPicker: THColorPicker;
FSelectedColor: TColor;
@ -23,8 +22,6 @@ type
FSLMenu, FHMenu: TPopupMenu;
FSLCursor, FHCursor: TCursor;
PBack: TBitmap;
function GetManual: boolean;
procedure SelectColor(c: TColor);
function GetH: Integer;
function GetS: Integer;
function GetL: Integer;
@ -46,26 +43,29 @@ type
procedure HPickerChange(Sender: TObject);
procedure SLPickerChange(Sender: TObject);
protected
procedure DoChange;
procedure DoChange; override;
procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
function GetColorUnderCursor: TColor; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
procedure Resize; override;
procedure SelectColor(c: TColor);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// procedure BeginUpdate; override;
// procedure EndUpdate(DoUpdate: Boolean = true); override;
function GetHexColorUnderCursor: string; override;
function GetSelectedHexColor: string;
procedure SetFocus; override;
property ColorUnderCursor;
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 Hue: integer read GetH write SetH default 0;
property Saturation: integer read GetS write SetS default 240;
property Luminance: integer read GetL write SetL default 120;
property SelectedColor: TColor read FSelectedColor write SelectColor default clRed;
property HPickerPopupMenu: TPopupMenu read FHMenu write SetHMenu;
property SLPickerPopupMenu: TPopupMenu read FSLMenu write SetSLMenu;
@ -73,6 +73,9 @@ type
property SLPickerHintFormat: string read FSLHint write SetSLHint;
property HPickerCursor: TCursor read FHCursor write SetHCursor default crDefault;
property SLPickerCursor: TCursor read FSLCursor write SetSLCursor default crDefault;
property MaxHue: Integer read FMaxH write SetMaxH default 359;
property MaxSaturation: Integer read FMaxS write SetMaxS default 240;
property MaxLuminance: Integer read FMaxL write SetMaxL default 240;
property TabStop default true;
property ShowHint;
property ParentShowHint;
@ -83,7 +86,7 @@ type
property TabOrder;
property Color;
property ParentColor default true;
property OnChange; //: TNotifyEvent read FOnChange write FOnChange;
property OnChange;
property OnMouseMove;
end;
@ -106,7 +109,7 @@ begin
FMaxH := 359;
FMaxS := 240;
FMaxL := 100;
FMaxL := 240;
PBack := TBitmap.Create;
// PBack.PixelFormat := pf32bit;
ParentColor := true;
@ -129,8 +132,8 @@ begin
MaxHue := FMaxH;
MaxSaturation := FMaxS;
MaxLuminance := FMaxL;
Saturation := FMaxS;
Luminance := FMaxL;
//Saturation := FMaxS;
//Luminance := FMaxL;
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
@ -143,7 +146,7 @@ begin
MaxHue := self.FMaxH;
MaxSaturation := 255;
MaxValue := 255;
Saturation := MaxSaturation;
//Saturation := MaxSaturation;
Value := MaxValue;
Visible := true;
ArrowPlacement := spBoth;
@ -152,9 +155,10 @@ begin
OnMouseMove := DoMouseMove;
end;
// red
FHValue := 0;
FSValue := 1.0;
FLValue := 1.0;
FLValue := 0.5;
FRValue := 255;
FGValue := 0;
FBValue := 0;
@ -170,20 +174,20 @@ end;
procedure TSLHColorPicker.DoChange;
begin
FSelectedColor := FSLPicker.SelectedColor;
FHValue := FHPicker.Hue / FHPicker.MaxHue;
FSValue := FSLPicker.Saturation / FSLPicker.MaxSaturation;
FLValue := FSLPicker.Luminance / FSLPicker.MaxLuminance;
FRValue := GetRValue(FSLPicker.SelectedColor);
FGValue := GetGValue(FSLPicker.SelectedColor);
FBValue := GetBValue(FSLPicker.SelectedColor);
if Assigned(OnChange) then OnChange(Self);
FRValue := GetRValue(FSelectedColor);
FGValue := GetGValue(FSelectedColor);
FBValue := GetBValue(FSelectedColor);
inherited;
end;
procedure TSLHColorPicker.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if Assigned(OnMouseMove) then
OnMouseMove(Self, Shift, x, y);
inherited;
end;
function TSLHColorPicker.GetColorUnderCursor: TColor;
@ -206,11 +210,6 @@ begin
Result := ROund(FLValue * FMaxL);
end;
function TSLHColorPicker.GetManual:boolean;
begin
Result := FHPicker.Manual or FSLPicker.Manual;
end;
function TSLHColorPicker.GetS: Integer;
begin
Result := Round(FSValue * FMaxS);
@ -223,10 +222,19 @@ end;
procedure TSLHColorPicker.HPickerChange(Sender: TObject);
begin
if FSLPicker.Hue = FHPicker.Hue then
exit;
FSLPicker.Hue := FHPicker.Hue;
DoChange;
end;
procedure TSLHColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
SetFocus;
inherited;
end;
procedure TSLHColorPicker.Paint;
begin
PaintParentBack(Canvas);
@ -262,6 +270,7 @@ end;
procedure TSLHColorPicker.SetFocus;
begin
inherited;
FSLPicker.SetFocus;
end;
@ -353,6 +362,8 @@ end;
procedure TSLHColorPicker.SLPickerChange(Sender: TObject);
begin
if FSLPicker.SelectedColor = FSelectedColor then
exit;
FSelectedColor := FSLPicker.SelectedColor;
DoChange;
end;

6
components/mbColorLib/SelPropUtils.pas
View File

@ -18,13 +18,13 @@ implementation
procedure DrawSelCross(x, y: integer; Canvas: TCanvas; Color: TColor);
const
w = 5;
h = 3;
w = 5; // Line length
h = 3; // Line width
o = 8;
var
R: TRect;
begin
R := Rect(x-10, y-10, x+9, y+9);
R := Rect(x - o - 1, y - o - 1, x + o + 1, y + o + 1);
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(R.Left, R.Top + o, R.Left + w, R.Top + o + h));
Canvas.FillRect(Rect(R.Left + o, R.Top, R.Left + o + h, R.Top + w));

293
components/mbColorLib/VColorPicker.pas
View File

@ -52,6 +52,9 @@ type
implementation
uses
mbUtils;
{TVColorPicker}
constructor TVColorPicker.Create(AOwner: TComponent);
@ -64,90 +67,8 @@ begin
FGradientHeight := 1;
FHue := 0;
FSat := 0;
FChange := false;
SetValue(FMaxVal);
HintFormat := 'Value: %value (selected)';
FManual := false;
FChange := true;
end;
function TVColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSVtoColor(FHue, FSat, AValue / FMaxVal);
end;
function TVColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TVColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TVColorPicker.GetValue: Integer;
begin
Result := round(FVal * FMaxVal);
end;
procedure TVColorPicker.SetHue(h: integer);
begin
if h > FMaxHue+1 then h := FMaxHue + 1;
if h < 0 then h := 0;
if GetHue() <> h then
begin
FHue := h / (FMaxHue + 1);
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TVColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetMaxVal(v: Integer);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
FGradientWidth := FMaxVal + 1;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetSat(s: integer);
begin
if s > FMaxSat then s := FMaxSat;
if s < 0 then s := 0;
if GetSat() <> s then
begin
FSat := s / FMaxSat;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TVColorPicker.ArrowPosFromVal(v: integer): integer;
@ -161,76 +82,13 @@ begin
end
else
begin
v := FMaxVal - v;
a := Round((Height - 12) * v / FMaxVal);
a := Round((Height - 12) * (FMaxVal - v) / FMaxVal);
if a > Height - FLimit then a := Height - FLimit;
end;
if a < 0 then a := 0;
Result := a;
end;
function TVColorPicker.ValFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p / (Width - 12) * FMaxVal)
else
r := Round(FMaxVal - p / (Height - 12) * FMaxVal);
if r < 0 then r := 0;
if r > FMaxVal then r := FMaxVal;
Result := r;
end;
procedure TVColorPicker.SetValue(V: integer);
begin
if v < 0 then v := 0;
if v > FMaxVal then v := FMaxVal;
if GetValue() <> v then
begin
FVal := v / FMaxVal;
FArrowPos := ArrowPosFromVal(v);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TVColorPicker.GetSelectedColor: TColor;
begin
Result := HSVtoColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TVColorPicker.GetSelectedValue: integer;
begin
Result := GetValue();
end;
procedure TVColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
begin
if WebSafe then c := GetWebSafe(c);
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
FChange := false;
SetHue(h);
SetSat(s);
SetValue(v);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
function TVColorPicker.GetArrowPos: integer;
begin
if FMaxVal = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromVal(GetValue());
end;
procedure TVColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
@ -267,4 +125,147 @@ begin
end;
end;
function TVColorPicker.GetArrowPos: integer;
begin
if FMaxVal = 0 then
Result := inherited GetArrowPos
else
Result := ArrowPosFromVal(GetValue());
end;
function TVColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := HSVtoColor(FHue, FSat, AValue / FMaxVal);
end;
function TVColorPicker.GetHue: Integer;
begin
Result := round(FHue * FMaxHue);
end;
function TVColorPicker.GetSat: Integer;
begin
Result := round(FSat * FMaxSat);
end;
function TVColorPicker.GetSelectedColor: TColor;
begin
Result := HSVtoColor(FHue, FSat, FVal);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TVColorPicker.GetSelectedValue: integer;
begin
Result := GetValue();
end;
function TVColorPicker.GetValue: Integer;
begin
Result := round(FVal * FMaxVal);
end;
procedure TVColorPicker.SetHue(h: integer);
begin
if h > FMaxHue+1 then h := FMaxHue + 1;
if h < 0 then h := 0;
if GetHue() <> h then
begin
FHue := h / (FMaxHue + 1);
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TVColorPicker.SetMaxHue(h: Integer);
begin
if h = FMaxHue then
exit;
FMaxHue := h;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetMaxSat(s: Integer);
begin
if s = FMaxSat then
exit;
FMaxSat := s;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetMaxVal(v: Integer);
begin
if v = FMaxVal then
exit;
FMaxVal := v;
FGradientWidth := FMaxVal + 1;
CreateGradient;
Invalidate;
// if FChange and Assigned(OnChange) then OnChange(Self);
end;
procedure TVColorPicker.SetSat(s: integer);
begin
if s > FMaxSat then s := FMaxSat;
if s < 0 then s := 0;
if GetSat() <> s then
begin
FSat := s / FMaxSat;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TVColorPicker.SetSelectedColor(c: TColor);
var
h, s, v: integer;
needNewGradient: Boolean;
begin
if WebSafe then
c := GetWebSafe(c);
if c = GetSelectedColor then
exit;
RGBToHSVRange(GetRValue(c), GetGValue(c), GetBValue(c), h, s, v);
needNewGradient := (h <> FHue) or (s <> FSat);
FHue := h;
FSat := s;
FVal := v;
if needNewGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TVColorPicker.SetValue(V: integer);
begin
if v < 0 then v := 0;
if v > FMaxVal then v := FMaxVal;
if GetValue() <> v then
begin
FVal := v / FMaxVal;
FArrowPos := ArrowPosFromVal(v);
Invalidate;
DoChange;
end;
end;
function TVColorPicker.ValFromArrowPos(p: integer): integer;
var
v: integer;
begin
case Layout of
lyHorizontal : v := Round(p / (Width - 12) * FMaxVal);
lyVertical : v := Round(FMaxVal - p / (Height - 12) * FMaxVal);
end;
Clamp(v, 0, FMaxVal);
Result := v;
end;
end.

221
components/mbColorLib/YColorPicker.pas
View File

@ -22,7 +22,7 @@ type
function ArrowPosFromYellow(y: integer): integer;
function YellowFromArrowPos(p: integer): integer;
function GetSelectedColor: TColor;
procedure SetSelectedColor(c: TColor);
procedure SetSelectedColor(clr: TColor);
procedure SetYellow(y: integer);
procedure SetMagenta(m: integer);
procedure SetCyan(c: integer);
@ -55,74 +55,12 @@ begin
inherited;
FGradientWidth := 255;
FGradientHeight := 1;
FYellow := 255;
FMagenta := 0;
FCyan := 0;
FBlack := 0;
FArrowPos := ArrowPosFromYellow(255);
FChange := false;
Layout := lyVertical;
SetYellow(255);
Layout := lyVertical;
HintFormat := 'Yellow: %value (selected)';
FManual := false;
FChange := true;
end;
function TYColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, AValue, FBlack);
end;
procedure TYColorPicker.SetYellow(y: integer);
begin
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
FArrowPos := ArrowPosFromYellow(y);
FManual := false;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TYColorPicker.SetMagenta(m: integer);
begin
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TYColorPicker.SetCyan(c: integer);
begin
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
procedure TYColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
FManual := false;
CreateGradient;
Invalidate;
if FChange and Assigned(OnChange) then OnChange(Self);
end;
end;
function TYColorPicker.ArrowPosFromYellow(y: integer): integer;
@ -144,62 +82,17 @@ begin
Result := a;
end;
function TYColorPicker.YellowFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
Clamp(r, 0, 255);
Result := r;
end;
function TYColorPicker.GetSelectedColor: TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TYColorPicker.GetSelectedValue: integer;
begin
Result := FYellow;
end;
procedure TYColorPicker.SetSelectedColor(c: TColor);
var
cy, m, y, k: integer;
begin
if WebSafe then c := GetWebSafe(c);
ColorToCMYK(c, cy, m, y, k);
FChange := false;
SetMagenta(m);
SetCyan(cy);
SetBlack(k);
SetYellow(y);
FManual := false;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
end;
function TYColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromYellow(FYellow);
end;
procedure TYColorPicker.Execute(tbaAction: integer);
begin
case tbaAction of
TBA_Resize:
SetYellow(FYellow);
TBA_MouseMove:
FYellow := YellowFromArrowPos(FArrowPos);
SetYellow(YellowFromArrowPos(FArrowPos));
TBA_MouseDown:
FYellow := YellowFromArrowPos(FArrowPos);
SetYellow(YellowFromArrowPos(FArrowPos));
TBA_MouseUp:
FYellow := YellowFromArrowPos(FArrowPos);
SetYellow(YellowFromArrowPos(FArrowPos));
TBA_WheelUp:
SetYellow(FYellow + Increment);
TBA_WheelDown:
@ -225,4 +118,108 @@ begin
end;
end;
function TYColorPicker.GetArrowPos: integer;
begin
Result := ArrowPosFromYellow(FYellow);
end;
function TYColorPicker.GetGradientColor(AValue: Integer): TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, AValue, FBlack);
end;
function TYColorPicker.GetSelectedColor: TColor;
begin
Result := CMYKtoColor(FCyan, FMagenta, FYellow, FBlack);
if WebSafe then
Result := GetWebSafe(Result);
end;
function TYColorPicker.GetSelectedValue: integer;
begin
Result := FYellow;
end;
procedure TYColorPicker.SetBlack(k: integer);
begin
Clamp(k, 0, 255);
if FBlack <> k then
begin
FBlack := k;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TYColorPicker.SetCyan(c: integer);
begin
Clamp(c, 0, 255);
if FCyan <> c then
begin
FCyan := c;
CreateGradient;
Invalidate;
DoChange;
end;
end;
procedure TYColorPicker.SetMagenta(m: integer);
begin
Clamp(m, 0, 255);
if FMagenta <> m then
begin
FMagenta := m;
CreateGradient;
Invalidate;
DoChange;
end;
end;
function TYColorPicker.YellowFromArrowPos(p: integer): integer;
var
r: integer;
begin
if Layout = lyHorizontal then
r := Round(p/((Width - 12)/255))
else
r := Round(255 - p/((Height - 12)/255));
Clamp(r, 0, 255);
Result := r;
end;
procedure TYColorPicker.SetSelectedColor(clr: TColor);
var
c, m, y, k: integer;
newGradient: Boolean;
begin
if WebSafe then
clr := GetWebSafe(clr);
if clr = GetSelectedColor then
exit;
ColorToCMYK(clr, c, m, y, k);
newGradient := (c <> FCyan) or (m <> FMagenta) or (k <> FBlack);
FCyan := c;
FMagenta := m;
FYellow := y;
FBlack := k;
if newGradient then
CreateGradient;
Invalidate;
DoChange;
end;
procedure TYColorPicker.SetYellow(y: integer);
begin
Clamp(y, 0, 255);
if FYellow <> y then
begin
FYellow := y;
FArrowPos := ArrowPosFromYellow(y);
Invalidate;
DoChange;
end;
end;
end.

1
components/mbColorLib/examples/axispickers/axispickers.lpi
View File

@ -9,7 +9,6 @@
<Title Value="axispickers"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>

66
components/mbColorLib/examples/axispickers/main.lfm
View File

@ -10,35 +10,39 @@ object Form1: TForm1
LCLVersion = '1.7'
object PageControl1: TPageControl
Left = 4
Height = 442
Height = 420
Top = 4
Width = 508
ActivePage = PgRED
Align = alClient
BorderSpacing.Around = 4
BorderSpacing.Left = 4
BorderSpacing.Top = 4
BorderSpacing.Right = 4
TabIndex = 0
TabOrder = 0
OnChange = PageControl1Change
object PgRED: TTabSheet
Caption = 'Picker based on RED'
ClientHeight = 414
ClientHeight = 392
ClientWidth = 500
object PanelRED: TPanel
Left = 0
Height = 414
Height = 392
Top = 0
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 414
ClientHeight = 392
ClientWidth = 500
TabOrder = 0
OnPaint = PanelREDPaint
object RColorPicker1: TRColorPicker
Left = 24
Height = 390
Height = 368
Top = 0
Width = 22
HintFormat = 'Red: %value (selected)'
SelectionIndicator = siRect
Align = alLeft
BorderSpacing.Left = 24
BorderSpacing.Bottom = 24
@ -48,7 +52,7 @@ object Form1: TForm1
end
object RAxisColorPicker1: TRAxisColorPicker
Left = 76
Height = 378
Height = 356
Top = 6
Width = 418
HintFormat = 'G: %g B: %b'#13'Hex: %hex'
@ -64,22 +68,22 @@ object Form1: TForm1
end
object PgGREEN: TTabSheet
Caption = 'Picker based on GREEN'
ClientHeight = 414
ClientHeight = 392
ClientWidth = 500
object PanelGREEN: TPanel
Left = 0
Height = 414
Height = 392
Top = 0
Width = 500
Align = alClient
BevelOuter = bvNone
ClientHeight = 414
ClientHeight = 392
ClientWidth = 500
TabOrder = 0
OnPaint = PanelGREENPaint
object GColorPicker1: TGColorPicker
Left = 24
Height = 390
Height = 368
Top = 0
Width = 22
HintFormat = 'Green: %value (selected)'
@ -92,7 +96,7 @@ object Form1: TForm1
end
object GAxisColorPicker1: TGAxisColorPicker
Left = 76
Height = 378
Height = 356
Top = 6
Width = 418
HintFormat = 'R: %r B: %b'#13'Hex: %hex'
@ -149,4 +153,42 @@ object Form1: TForm1
end
end
end
object Panel1: TPanel
Left = 0
Height = 26
Top = 424
Width = 516
Align = alBottom
BevelOuter = bvNone
ClientHeight = 26
ClientWidth = 516
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = mbColorPreview1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = mbColorPreview1
AnchorSideTop.Side = asrCenter
Left = 76
Height = 15
Top = 5
Width = 34
BorderSpacing.Left = 8
Caption = 'Label1'
ParentColor = False
end
object mbColorPreview1: TmbColorPreview
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideBottom.Control = Panel1
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 20
Top = 2
Width = 60
Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Bottom = 4
end
end
end

36
components/mbColorLib/examples/axispickers/main.pas
View File

@ -7,14 +7,17 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, ComCtrls, RAxisColorPicker, RColorPicker, GColorPicker,
GAxisColorPicker, BColorPicker, BAxisColorPicker;
GAxisColorPicker, BColorPicker, BAxisColorPicker, mbColorPreview;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
mbColorPreview1: TmbColorPreview;
PageControl1: TPageControl;
Panel1: TPanel;
RAxisColorPicker1: TRAxisColorPicker;
BAxisColorPicker1: TBAxisColorPicker;
GAxisColorPicker1: TGAxisColorPicker;
@ -32,11 +35,14 @@ type
procedure FormCreate(Sender: TObject);
procedure GAxisColorPicker1Change(Sender: TObject);
procedure GColorPicker1Change(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure PanelBLUEPaint(Sender: TObject);
procedure PanelGREENPaint(Sender: TObject);
procedure PanelREDPaint(Sender: TObject);
procedure RAxisColorPicker1Change(Sender: TObject);
procedure RColorPicker1Change(Sender: TObject);
private
procedure UpdatePreview;
public
end;
@ -49,18 +55,20 @@ implementation
{$R *.lfm}
uses
Types, GraphUtil;
LclIntf, Types, GraphUtil, HTMLColors;
{ TForm1 }
procedure TForm1.BAxisColorPicker1Change(Sender: TObject);
begin
BColorPicker1.SelectedColor := BAxisColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.BColorPicker1Change(Sender: TObject);
begin
BAxisColorPicker1.SelectedColor := BColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.FormCreate(Sender: TObject);
@ -68,16 +76,24 @@ begin
RAxisColorPicker1.SelectedColor := clRed;
GAxisColorPicker1.SelectedColor := clGreen;
BAxisColorPicker1.SelectedColor := clBlue;
UpdatePreview;
end;
procedure TForm1.GAxisColorPicker1Change(Sender: TObject);
begin
GColorPicker1.SelectedColor := GAxisColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.GColorPicker1Change(Sender: TObject);
begin
GAxisColorPicker1.SelectedColor := GColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.PageControl1Change(Sender: TObject);
begin
UpdatePreview;
end;
// On BlueAxisPicker, x is RED, y is GREEN
@ -190,12 +206,28 @@ end;
procedure TForm1.RAxisColorPicker1Change(Sender: TObject);
begin
RColorPicker1.SelectedColor := RAxisColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.RColorPicker1Change(Sender: TObject);
begin
RAXisColorPicker1.SelectedColor := RColorPicker1.SelectedColor;
UpdatePreview;
end;
procedure TForm1.UpdatePreview;
begin
case PageControl1.ActivePageindex of
0: mbColorPreview1.Color := RColorPicker1.SelectedColor;
1: mbColorPreview1.Color := GColorPicker1.SelectedColor;
2: mbColorPreview1.Color := BColorPicker1.SelectedColor;
end;
Label1.Caption := Format('R=%d G=%d B=%d HTML=#%s', [
GetRValue(mbColorPreview1.Color),
GetGValue(mbColorPreview1.Color),
GetBValue(mbColorPreview1.Color),
ColorToHex(mbColorPreview1.Color)
]);
end;
end.

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

@ -15,10 +15,10 @@ object Form1: TForm1
Height = 404
Top = 6
Width = 476
ActivePage = TabSheet1
ActivePage = TabSheet7
Align = alClient
BorderSpacing.Around = 6
TabIndex = 0
TabIndex = 7
TabOrder = 0
OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove
@ -31,6 +31,7 @@ object Form1: TForm1
Height = 360
Top = 8
Width = 454
Saturation = 146
SelectedColor = 3289805
HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex'
LPickerHintFormat = 'Luminance: %l'
@ -608,6 +609,7 @@ object Form1: TForm1
Height = 351
Top = 6
Width = 322
Luminance = 240
RingPickerHintFormat = 'Hue: %h'
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight, akBottom]
@ -626,13 +628,12 @@ object Form1: TForm1
Height = 362
Top = 6
Width = 405
SelectedColor = clWhite
HintFormat = 'H: %h S: %s V: %v'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight, akBottom]
TabOrder = 0
OnMouseMove = HSVColorPicker1MouseMove
Hue = 0
Saturation = 0
Value = 255
OnChange = HSVColorPicker1Change
end
object VColorPicker2: TVColorPicker
@ -662,6 +663,7 @@ object Form1: TForm1
Height = 364
Top = 6
Width = 458
Luminance = 100
HPickerHintFormat = 'Hue: %h (selected)'
SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
Anchors = [akTop, akLeft, akRight, akBottom]
@ -785,9 +787,8 @@ object Form1: TForm1
Anchors = [akLeft, akRight, akBottom]
TabOrder = 2
Hue = 0
Saturation = 0
Luminance = 48
SelectedColor = 3158064
Saturation = 240
Luminance = 120
end
object VColorPicker1: TVColorPicker
Left = 34
@ -800,10 +801,9 @@ object Form1: TForm1
SelectionIndicator = siRect
Anchors = [akLeft, akRight, akBottom]
TabOrder = 3
Hue = 239
Hue = 0
Saturation = 255
Value = 40
SelectedColor = 2621440
Value = 255
end
object HColorPicker1: THColorPicker
Left = 34
@ -907,6 +907,8 @@ object Form1: TForm1
HintFormat = 'H: %h S: %s'#13'Hex: %hex'
TabOrder = 0
OnMouseMove = HSColorPicker1MouseMove
Hue = 240
Saturation = 214
MarkerStyle = msSquare
OnChange = HSColorPicker1Change
end
@ -915,12 +917,10 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 161
SelectedColor = 6579300
SelectedColor = 6974058
HintFormat = 'H: %h S: %s L: %l'#13'Hex: %hex'
TabOrder = 1
OnMouseMove = SLColorPicker1MouseMove
Hue = 0
Saturation = 0
Luminance = 100
MarkerStyle = msCross
OnChange = SLColorPicker1Change
@ -930,6 +930,7 @@ object Form1: TForm1
Height = 130
Top = 168
Width = 133
SelectedColor = clRed
HintFormat = 'Hue: %h (selected)'
TabOrder = 2
OnMouseMove = HRingPicker1MouseMove
@ -1220,9 +1221,9 @@ object Form1: TForm1
BorderSpacing.Top = 4
BorderSpacing.Right = 10
TabOrder = 5
LValue = 88
AValue = -88
BValue = 74
LValue = 88
end
object LblGAxisPicker: TLabel
AnchorSideLeft.Control = GAxisColorPicker1

2
components/mbColorLib/examples/fulldemo/main.pas
View File

@ -4,7 +4,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants,Classes, Graphics, Controls,
LCLIntf, LCLType, SysUtils, Variants,Classes, Graphics, Controls,
Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils,
SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker,

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

@ -206,8 +206,8 @@ object Form1: TForm1
OnChange = SLVPickerV_Change
Hue = 0
Saturation = 0
Luminance = 240
SelectedColor = 15790320
Luminance = 226
SelectedColor = 14869218
end
object HColorPickerV: THColorPicker
AnchorSideTop.Control = LblH
@ -518,8 +518,8 @@ object Form1: TForm1
OnChange = SLVPickerH_Change
Hue = 0
Saturation = 0
Luminance = 240
SelectedColor = 15790320
Luminance = 226
SelectedColor = 14869218
end
object SColorPickerH: TSColorPicker
Left = 24

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

@ -153,7 +153,6 @@ begin
]);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MaxHue := 359;
@ -181,6 +180,8 @@ end;
procedure TForm1.HPickerH_Change(Sender: TObject);
begin
exit;
SLVPickerH_Change(nil);
SColorPickerH.Hue := HColorPickerH.Hue;
LColorPickerH.Hue := HColorPickerH.Hue;

8
components/mbColorLib/mbBasicPicker.pas
View File

@ -19,11 +19,11 @@ type
FOnGetHintStr: TGetHintStrEvent;
protected
FBufferBmp: TBitmap;
FChange: Boolean;
FGradientWidth: Integer;
FGradientHeight: Integer;
FHintShown: Boolean;
procedure CreateGradient; virtual;
procedure DoChange; virtual;
function GetColorUnderCursor: TColor; virtual;
function GetGradientColor(AValue: Integer): TColor; virtual;
function GetGradientColor2D(X, Y: Integer): TColor; virtual;
@ -110,6 +110,12 @@ begin
// to be implemented by descendants
end;
procedure TmbBasicPicker.DoChange;
begin
if Assigned(FOnChange) then
FOnChange(self);
end;
function TmbBasicPicker.GetColorAtPoint(x, y: integer): TColor;
begin
Result := Canvas.Pixels[x, y]; // valid for most descendents

2
components/mbColorLib/mbColorPickerControl.pas
View File

@ -24,7 +24,6 @@ type
FManual: Boolean;
FSelected: TColor;
mx, my, mdx, mdy: integer;
FOnChange: TNotifyEvent;
procedure CreateGradient; override;
function GetHintStr(X, Y: Integer): String; override;
function GetSelectedColor: TColor; virtual;
@ -44,7 +43,6 @@ type
procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
{$ENDIF}
property MarkerStyle: TMarkerStyle read FMarkerStyle write SetMarkerStyle;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
public
constructor Create(AOwner: TComponent); override;
property ColorUnderCursor;

9
components/mbColorLib/mbColorPreview.pas
View File

@ -22,6 +22,7 @@ type
procedure SetOpacity(o: integer);
procedure SetBlockSize(s: integer);
protected
procedure DoChange;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
@ -32,6 +33,7 @@ type
property SwatchStyle: boolean read FSwatchStyle write SetSwatchStyle default false;
property Anchors;
property Align;
property BorderSpacing;
property ShowHint;
property ParentShowHint;
property Visible;
@ -81,6 +83,12 @@ begin
FSwatchStyle := false;
end;
procedure TmbColorPreview.DoChange;
begin
if Assigned(FOnColorChange) then
FOnColorChange(self);
end;
function TmbColorPreview.MakeBmp: TBitmap;
begin
Result := TBitmap.Create;
@ -209,7 +217,6 @@ begin
begin
FSelColor := c;
Invalidate;
if Assigned(FOnColorChange) then FOnColorChange(Self);
end;
end;

3
components/mbColorLib/mbOfficeColorDialog.pas
View File

@ -36,6 +36,8 @@ end;
function TmbOfficeColorDialog.Execute: boolean;
begin
Result := Execute(FSelColor);
{
FWin := TOfficeMoreColorsWin.Create(Application);
try
FWin.OldSwatch.Color := FSelColor;
@ -48,6 +50,7 @@ begin
finally
FWin.Free;
end;
}
end;
function TmbOfficeColorDialog.Execute(AColor: TColor): boolean;

117
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -42,7 +42,6 @@ type
FBevelOuter: TBevelCut;
FBevelWidth: TBevelWidth;
FBorderStyle: TBorderStyle;
FDoChange: boolean;
FHintFormat: string;
FIncrement: integer;
FNewArrowStyle: boolean;
@ -64,8 +63,6 @@ type
protected
FArrowPos: integer;
// FBack: TBitmap;
FChange: boolean;
FManual: boolean;
FLayout: TTrackBarLayout;
FLimit: integer;
FPickRect: TRect;
@ -93,7 +90,6 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Manual: boolean read FManual;
published
property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
@ -147,7 +143,7 @@ type
implementation
uses
IntfGraphics, fpimage,
IntfGraphics, fpimage, Math,
ScanLines, HTMLColors;
const
@ -194,15 +190,13 @@ begin
FIncrement := 1;
FArrowPos := GetArrowPos;
FHintFormat := '';
FManual := false;
FChange := true;
FLayout := lyHorizontal;
FNewArrowStyle := false;
Aw := 6;
Ah := 10;
FPlacement := spAfter;
FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah);
FDoChange := false;
// FDoChange := false;
FSelIndicator := siArrows;
FLimit := 7;
FWebSafe := false;
@ -256,12 +250,9 @@ begin
case FSelIndicator of
siArrows:
case FPlacement of
spAfter:
FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah - f);
spBefore:
FPickRect := Rect(Aw, Ah + f, Width - Aw, Height);
spBoth:
FPickRect := Rect(Aw, Ah + f, Width - Aw, Height - Ah - f);
spAfter : FPickRect := Rect(Aw, 0, Width - Aw, Height - Ah - f);
spBefore : FPickRect := Rect(Aw, Ah + f, Width - Aw, Height);
spBoth : FPickRect := Rect(Aw, Ah + f, Width - Aw, Height - Ah - f);
end;
siRect:
FPickRect := Rect(Aw, Ah, width - 2*Aw + 1, height - Ah);
@ -270,12 +261,9 @@ begin
case FSelIndicator of
siArrows:
case FPlacement of
spAfter:
FPickRect := Rect(0, Aw, Width - Ah - f, Height - Aw);
spBefore:
FPickRect := Rect(Ah + f, Aw, Width, Height - Aw);
spBoth:
FPickRect := Rect(Ah + f, Aw, Width - Ah - f, Height - Aw);
spAfter : FPickRect := Rect(0, Aw, Width - Ah - f, Height - Aw);
spBefore : FPickRect := Rect(Ah + f, Aw, Width, Height - Aw);
spBoth : FPickRect := Rect(Ah + f, Aw, Width - Ah - f, Height - Aw);
end;
siRect:
FPickRect := Rect(Ah, Aw, width - 5, height - 2*Aw + 1);
@ -362,14 +350,11 @@ begin
if not Result then
begin
Result := True;
FChange := false;
if WheelDelta > 0 then
Execute(TBA_WheelUp)
else
Execute(TBA_WheelDown);
FManual := true;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
DoChange;
end;
end;
@ -591,56 +576,44 @@ begin
eraseKey := false
else
begin
FChange := false;
if not (ssCtrl in Shift) then
Execute(TBA_VKUp)
else
Execute(TBA_VKCtrlUp);
FManual := true;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
DoChange;
end;
VK_LEFT:
if FLayout = lyVertical then
eraseKey := false
else
begin
FChange := false;
if not (ssCtrl in Shift) then
Execute(TBA_VKLeft)
else
Execute(TBA_VKCtrlLeft);
FManual := true;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
DoChange;
end;
VK_RIGHT:
if FLayout = lyVertical then
eraseKey := false
else
begin
FChange := false;
if not (ssCtrl in Shift) then
Execute(TBA_VKRight)
else
Execute(TBA_VKCtrlRight);
FManual := true;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
DoChange;
end;
VK_DOWN:
if FLayout = lyHorizontal then
eraseKey := false
else
begin
FChange := false;
if not (ssCtrl in Shift) then
Execute(TBA_VKDown)
else
Execute(TBA_VKCtrlDown);
FManual := true;
FChange := true;
if Assigned(OnChange) then OnChange(Self);
DoChange;
end
else
eraseKey := false;
@ -654,18 +627,15 @@ end;
procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then Exit;
mx := x;
my := y;
if Button = mbLeft then
begin
SetFocus;
if FLayout = lyHorizontal then
FArrowPos := XToArrowPos(x)
else
FArrowPos := YToArrowPos(y);
mx := X;
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseDown);
FManual := true;
FDoChange := true;
Invalidate;
//Invalidate;
end;
inherited;
end;
@ -676,48 +646,29 @@ begin
end;
procedure TmbTrackBarPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
if ssLeft in shift then
begin
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
mx := x;
my := y;
if FLayout = lyHorizontal then
FArrowPos := XToArrowPos(x)
else
FArrowPos := YToArrowPos(y);
mx := X;
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseMove);
FManual := true;
FDoChange := true;
Invalidate;
// Invalidate;
end;
inherited;
end;
procedure TmbTrackBarPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
if Button <> mbLeft then
exit;
mx := x;
my := y;
if FLayout = lyHorizontal then
FArrowPos := XToArrowPos(x)
else
FArrowPos := YToArrowPos(y);
if Button = mbLeft then
begin
mx := X;
my := Y;
FArrowPos := IfThen(FLayout = lyHorizontal, XToArrowPos(X), YToArrowPos(Y));
Execute(TBA_MouseUp);
FManual := true;
FDoChange := true;
Invalidate;
// Invalidate;
end;
inherited;
end;
@ -730,19 +681,19 @@ begin
if FBorderStyle <> bsNone then
DrawFrames;
DrawMarker(FArrowPos);
{
if FDoChange then
begin
if Assigned(OnChange) then OnChange(Self);
FDoChange := false;
end;
}
end;
procedure TmbTrackBarPicker.Resize;
begin
inherited;
FChange := false;
Execute(TBA_Resize);
FChange := true;
end;
procedure TmbTrackBarPicker.SetBevelInner(Value: TBevelCut);