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

mbColorLib: Fix keyboard handling of all colorLib components (arrow keys stay within control and don't focus next control any more).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5541 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-12-19 21:36:01 +00:00
parent c75b85e42a
commit 32710fa5af
19 changed files with 1007 additions and 492 deletions
Download Patch File Download Diff File Expand all files Collapse all files

137
components/mbColorLib/BAxisColorPicker.pas
View File

@ -24,18 +24,21 @@ type
procedure SetGValue(g: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -78,24 +81,18 @@ begin
MarkerStyle := msCircle;
end;
procedure TBAxisColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
{ x is RED, y is GREEN }
function TBAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
Result := RGB(x, FBufferBmp.Height - 1 - y, FB);
end;
procedure TBAxisColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width - 1);
Clamp(y, 0, Height - 1);
end;
procedure TBAxisColorPicker.CreateWnd;
begin
inherited;
CreateGradient;
end;
procedure TBAxisColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
@ -104,8 +101,6 @@ begin
FR := GetRValue(FSelected);
FG := GetGValue(FSelected);
FB := GetBValue(FSelected);
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -115,18 +110,10 @@ begin
InternalDrawMarker(x, y, c);
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
{ x is RED, y is GREEN }
function TBAxisColorPicker.GetGradientColor2D(x, y: Integer): TColor;
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
FSelected := c;
FManual := false;
mxx := Round(FR*(Width/255));
myy := Round((255-FG)*(Height/255));
CreateGradient;
Invalidate;
Result := RGB(x, FBufferBmp.Height - 1 - y, FB);
end;
procedure TBAxisColorPicker.Paint;
@ -144,6 +131,77 @@ begin
inherited;
end;
procedure TBAxisColorPicker.SetSelectedColor(c: TColor);
begin
if WebSafe then c := GetWebSafe(c);
FR := GetRValue(c);
FG := GetGValue(c);
FB := GetBValue(c);
FSelected := c;
FManual := false;
mxx := Round(FR*(Width/255));
myy := Round((255-FG)*(Height/255));
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
procedure TBAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
case Key of
VK_LEFT:
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;
end;
if eraseKey then Key := 0;
inherited;
end;
procedure TBAxisColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
@ -154,10 +212,10 @@ begin
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
@ -173,11 +231,15 @@ begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end;
procedure TBAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -190,9 +252,10 @@ begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end;
(*
procedure TBAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -289,7 +352,7 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
procedure TBAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);

191
components/mbColorLib/CIEAColorPicker.pas
View File

@ -24,18 +24,21 @@ type
procedure SetAValue(a: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -112,8 +115,6 @@ begin
FL := Round(GetCIELValue(FSelected));
FA := Round(GetCIEAValue(FSelected));
FB := Round(GetCIEBValue(FSelected));
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -131,10 +132,11 @@ begin
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FB+128)*(Width/255));
myy := Round(((100-FL)*255/100)*(Height/255));
CreateGradient;
mxx := Round((FB + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100 * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIEAColorPicker.Paint;
@ -147,8 +149,8 @@ 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) * Width / 255);
myy := Round(((100 - FL) * 255 / 100) * Height / 255);
inherited;
end;
@ -161,15 +163,17 @@ begin
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
SetFocus;
end;
@ -180,11 +184,16 @@ begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEAColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -197,104 +206,70 @@ begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEAColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
procedure TCIEAColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
Shift: TShiftState;
FInherited: boolean;
eraseKey: Boolean;
delta: Integer;
begin
FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 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
begin
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
eraseKey := false;
end;
if not FInherited then
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
if eraseKey then Key := 0;
inherited;
end;
procedure TCIEAColorPicker.SetLValue(l: integer);

192
components/mbColorLib/CIEBColorPicker.pas
View File

@ -27,18 +27,20 @@ type
procedure SetAValue(a: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
message CN_KEYDOWN;*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -110,8 +112,6 @@ begin
FL := Round(GetCIELValue(FSelected));
FA := Round(GetCIEAValue(FSelected));
FB := Round(GetCIEBValue(FSelected));
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -129,10 +129,11 @@ begin
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA+128)*(Width/255));
myy := Round(((100-FL)*255/100)*(Height/255));
CreateGradient;
mxx := Round((FA + 128) * Width / 255);
myy := Round((100 - FL) * 255 / 100* Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIEBColorPicker.Paint;
@ -175,14 +176,19 @@ end;
procedure TCIEBColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -195,104 +201,70 @@ begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIEBColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
procedure TCIEBColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
Shift: TShiftState;
FInherited: boolean;
eraseKey: Boolean;
delta: Integer;
begin
FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 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;
end;
if not FInherited then
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
if eraseKey then Key := 0;
inherited;
end;
procedure TCIEBColorPicker.SetLValue(L: integer);

193
components/mbColorLib/CIELColorPicker.pas
View File

@ -24,18 +24,21 @@ type
procedure SetAValue(a: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -77,6 +80,7 @@ begin
mxx := 0;
myy := 0;
MarkerStyle := msCircle;
SetSelectedColor(clAqua);
end;
procedure TCIELColorPicker.CreateWnd;
@ -105,8 +109,6 @@ begin
FL := Round(GetCIELValue(FSelected));
FA := Round(GetCIEAValue(FSelected));
FB := Round(GetCIEBValue(FSelected));
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -124,10 +126,11 @@ begin
FB := Round(GetCIEBValue(c));
FSelected := c;
FManual := false;
mxx := Round((FA+128)*(Width/255));
myy := Round((255-(FB+128))*(Height/255));
CreateGradient;
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TCIELColorPicker.Paint;
@ -140,8 +143,8 @@ end;
procedure TCIELColorPicker.Resize;
begin
FManual := false;
mxx := Round((FA+128)*(Width/255));
myy := Round((255-(FB+128))*(Height/255));
mxx := Round((FA + 128) * Width / 255);
myy := Round((255 - (FB + 128)) * Height / 255);
inherited;
end;
@ -170,14 +173,19 @@ end;
procedure TCIELColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIELColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -190,104 +198,69 @@ begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TCIELColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
procedure TCIELColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
Shift: TShiftState;
FInherited: boolean;
eraseKey: Boolean;
delta: Integer;
begin
FInherited := false;
Shift := KeyDataToShiftState(Message.KeyData);
if not (ssCtrl in Shift) then
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 1;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 1;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
erasekey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 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
begin
FInherited := true;
inherited;
end;
end
else
case Message.CharCode of
VK_LEFT:
begin
mxx := dx - 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + 10;
myy := dy;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + 10;
Refresh;
FSelected := GetColorAtPoint(mxx, myy);
FManual := true;
Invalidate;
end;
else
begin
FInherited := true;
inherited;
end;
eraseKey := false;
end;
if not FInherited then
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
if eraseKey then Key := 0;
inherited;
end;
procedure TCIELColorPicker.SetLValue(l: integer);

126
components/mbColorLib/GAxisColorPicker.pas
View File

@ -24,18 +24,21 @@ type
procedure SetGValue(g: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
@ -78,6 +81,12 @@ begin
MarkerStyle := msCircle;
end;
procedure TGAxisColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width-1);
Clamp(y, 0, Height-1);
end;
procedure TGAxisColorPicker.CreateWnd;
begin
inherited;
@ -89,12 +98,6 @@ begin
Result := RGB(FBufferBmp.Height - 1 - y, FG, x);
end;
procedure TGAxisColorPicker.CorrectCoords(var x, y: integer);
begin
Clamp(x, 0, Width-1);
Clamp(y, 0, Height-1);
end;
procedure TGAxisColorPicker.DrawMarker(x, y: integer);
var
c: TColor;
@ -103,8 +106,6 @@ begin
FR := GetRValue(FSelected);
FG := GetGValue(FSelected);
FB := GetBValue(FSelected);
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -122,10 +123,11 @@ begin
FB := GetBValue(c);
FSelected := c;
FManual := false;
myy := Round((255-FR)*(Height/255));
mxx := Round(FB*(Width/255));
CreateGradient;
myy := Round((255 - FR) * Height / 255);
mxx := Round(FB * Width / 255);
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
procedure TGAxisColorPicker.Paint;
@ -138,8 +140,69 @@ end;
procedure TGAxisColorPicker.Resize;
begin
FManual := false;
myy := Round((255-FR)*(Height/255));
mxx := Round(FB*(Width/255));
myy := Round((255 - FR) * Height / 255);
mxx := Round(FB * Width / 255);
inherited;
end;
procedure TGAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if (ssCtrl in Shift) then delta := 10 else delta := 1;
case Key of
VK_LEFT:
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;
end;
if eraseKey then Key := 0;
inherited;
end;
@ -152,10 +215,10 @@ begin
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
@ -168,14 +231,19 @@ end;
procedure TGAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := X;
myy := Y;
FSelected := GetColorAtPoint(X, Y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := X;
myy := Y;
FSelected := GetColorAtPoint(X, Y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TGAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -188,9 +256,11 @@ begin
FSelected := GetColorAtPoint(X, Y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
(*
procedure TGAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
var
@ -287,7 +357,7 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
procedure TGAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);

48
components/mbColorLib/HRingPicker.pas
View File

@ -51,12 +51,15 @@ type
procedure Paint; override;
procedure Resize; override;
// procedure CreateWnd; 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;
function MouseOnPicker(X, Y: Integer): Boolean; override;
function MouseOnPicker(X, Y: Integer): Boolean;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
@ -185,7 +188,8 @@ end;
procedure THRingPicker.SetHue(h: integer);
begin
Clamp(h, 0, FMaxHue);
if h > FMaxHue then h := h - (FMaxHue + 1);
if h < 0 then h := h + (FMaxHue + 1);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
@ -339,6 +343,42 @@ begin
Invalidate;
end;
procedure THRingPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if ssCtrl in Shift then
delta := 10
else
delta := 1;
case Key of
VK_LEFT:
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;
end;
if eraseKey then Key := 0;
inherited;
end;
procedure THRingPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
@ -475,7 +515,7 @@ begin
if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New;
end;
(*
procedure THRingPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -516,5 +556,5 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
end.

62
components/mbColorLib/HSColorPicker.pas
View File

@ -39,8 +39,11 @@ type
procedure CorrectCoords(var x, y: integer);
function GetGradientColor2D(X, Y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
@ -187,6 +190,63 @@ begin
inherited;
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;
case Key of
VK_LEFT:
begin
mxx := dx - delta;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
if Assigned(OnChange) then OnChange(Self);
FManual := true;
Invalidate;
end;
VK_RIGHT:
begin
mxx := dx + delta;
myy := dy;
FSelected := GetColorAtPoint(mxx, myy);
if Assigned(OnChange) then OnChange(Self);
FManual := true;
Invalidate;
end;
VK_UP:
begin
mxx := dx;
myy := dy - delta;
FSelected := GetColorAtPoint(mxx, myy);
if Assigned(OnChange) then OnChange(Self);
FManual := true;
Invalidate;
end;
VK_DOWN:
begin
mxx := dx;
myy := dy + delta;
FSelected := GetColorAtPoint(mxx, myy);
if Assigned(OnChange) then OnChange(Self);
FManual := true;
Invalidate;
end;
else
eraseKey := false;
end;
if eraseKey then
Key := 0;
inherited;
end;
procedure THSColorPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{$IFDEF DELPHI}
var
@ -249,6 +309,7 @@ begin
Result := HSLToRGB(H, S, L);
end;
(*
procedure THSColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -306,6 +367,7 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
procedure THSColorPicker.SetHue(H: integer);
begin

7
components/mbColorLib/HSLColorPicker.pas
View File

@ -137,6 +137,7 @@ begin
FLumIncrement := 1;
FHSCursor := crDefault;
FLCursor := crDefault;
with FHSPicker do
begin
{$IFDEF DELPHI}
@ -155,6 +156,7 @@ begin
OnChange := HSPickerChange;
OnMouseMove := DoMouseMove;
end;
FLPicker := TLColorPicker.Create(Self);
InsertControl(FLPicker);
with FLPicker do
@ -177,6 +179,7 @@ begin
OnChange := LPickerChange;
OnMouseMove := DoMouseMove;
end;
Hue := 0;
Saturation := 240;
Luminance := 120;
@ -190,8 +193,8 @@ end;
destructor THSLColorPicker.Destroy;
begin
PBack.Free;
FHSPicker.Free;
FLPicker.Free;
//FHSPicker.Free;
//FLPicker.Free;
inherited Destroy;
end;

29
components/mbColorLib/HSLRingPicker.pas
View File

@ -62,11 +62,14 @@ type
procedure SLPickerChange(Sender: TObject);
procedure DoChange;
procedure Resize; override;
procedure SetFocus; override;
(*
{$IFDEF DELPHI}
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
{$ELSE}
procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
{$ENDIF}
*)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -131,12 +134,16 @@ begin
{$ELSE}
SetInitialBounds(0, 0, 245, 245);
{$ENDIF}
TabStop := true;
FSelectedColor := clRed;
FRingPicker := THRingPicker.Create(Self);
InsertControl(FRingPicker);
FRingCursor := crDefault;
FSLCursor := crDefault;
FRingHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
FRingPicker := THRingPicker.Create(Self);
InsertControl(FRingPicker);
with FRingPicker do
begin
{$IFDEF DELPHI}
@ -156,6 +163,7 @@ begin
OnChange := RingPickerChange;
OnMouseMove := DoMouseMove;
end;
FSLPicker := TSLColorPicker.Create(Self);
InsertControl(FSLPicker);
with FSLPicker do
@ -176,15 +184,13 @@ begin
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
FRingHint := 'Hue: %h';
FSLHint := 'S: %hslS L: %l'#13'Hex: %hex';
end;
destructor THSLRingPicker.Destroy;
begin
PBack.Free;
FRingPicker.Free;
FSLPicker.Free;
//FRingPicker.Free;
//FSLPicker.Free;
inherited Destroy;
end;
@ -197,7 +203,7 @@ begin
if (FRingPicker = nil) or (FSLPicker = nil) then
exit;
ctr := Min(Width, Height)/100;
ctr := Min(Width, Height) / 100;
circ.x := Min(Width, Height) div 2;
circ.y := circ.x;
@ -350,13 +356,20 @@ begin
FSLCursor := c;
FSLPicker.Cursor := c;
end;
(*
procedure THSLRingPicker.WMSetFocus(
var Message: {$IFDEF DELPHI}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF} );
begin
FRingPicker.SetFocus;
Message.Result := 1;
end;
*)
procedure THSLRingPicker.SetFocus;
begin
inherited;
FRingPicker.SetFocus;
end;
function THSLRingPicker.GetManual:boolean;
begin

69
components/mbColorLib/HSVColorPicker.pas
View File

@ -56,12 +56,15 @@ type
procedure Paint; override;
procedure Resize; override;
procedure CreateWnd; 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;
function MouseOnPicker(X, Y: Integer): Boolean; override;
// function MouseOnPicker(X, Y: Integer): Boolean; override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
@ -223,7 +226,9 @@ end;
procedure THSVColorPicker.SetHue(h: integer);
begin
Clamp(h, 0, FMaxHue);
if h > FMaxHue then h := h - (FMaxHue + 1);
if h < 0 then h := h + (FMaxHue + 1);
// Clamp(h, 0, FMaxHue);
if GetHue() <> h then
begin
FHue := h / FMaxHue;
@ -419,6 +424,58 @@ begin
Invalidate;
end;
procedure THSVColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
delta: Integer;
begin
eraseKey := true;
if ssCtrl in shift then
delta := 10
else
delta := 1;
case Key of
VK_LEFT:
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;
end;
if eraseKey then Key := 0;
inherited;
end;
procedure THSVColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
@ -480,7 +537,7 @@ begin
FManual := true;
end;
end;
(*
function THSVColorPicker.MouseOnPicker(X, Y: Integer): Boolean;
var
diameter, r: Integer;
@ -492,7 +549,7 @@ begin
ctr := Point(r, r);
Result := PtInCircle(P, ctr, r);
end;
*)
function THSVColorPicker.GetSelectedColor: TColor;
begin
if FSelectedColor <> clNone then
@ -556,7 +613,7 @@ begin
if New > (FMaxHue + 1) then New := New - (FMaxHue + 1);
Result := New;
end;
(*
procedure THSVColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -614,5 +671,5 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
end.

2
components/mbColorLib/HexaColorPicker.pas
View File

@ -238,7 +238,7 @@ destructor THexaColorPicker.Destroy;
begin
FBWCombs := nil;
FColorCombs := nil;
FBufferBmp.Free;
// FBufferBmp.Free; is already destroyed by ancestor TmbBasicPicker
inherited;
end;

113
components/mbColorLib/RAxisColorPicker.pas
View File

@ -24,25 +24,28 @@ type
procedure SetGValue(g: integer);
procedure SetBValue(b: integer);
protected
procedure CorrectCoords(var x, y: integer);
procedure CreateWnd; override;
procedure DrawMarker(x, y: integer);
function GetGradientColor2D(x, y: Integer): TColor; override;
procedure SetSelectedColor(c: TColor); override;
(*
procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
*)
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;
procedure Resize; override;
procedure CreateWnd; override;
procedure CorrectCoords(var x, y: integer);
procedure SetSelectedColor(c: TColor); override;
public
constructor Create(AOwner: TComponent); override;
published
property SelectedColor default clRed;
property RValue: integer read FR write SetRValue default 255;
property GValue: integer read FG write SetGValue default 0;
property BValue: integer read FB write SetBValue default 0;
property Red: integer read FR write SetRValue default 255;
property Green: integer read FG write SetGValue default 0;
property Blue: integer read FB write SetBValue default 0;
property MarkerStyle default msCircle;
property OnChange;
end;
@ -104,8 +107,6 @@ begin
FR := GetRValue(FSelected);
FG := GetGValue(FSelected);
FB := GetBValue(FSelected);
if Assigned(FOnChange) then
FOnChange(Self);
dx := x;
dy := y;
if Focused or (csDesigning in ComponentState) then
@ -125,8 +126,8 @@ begin
FManual := false;
myy := Round((255-FG)*(Height/255));
mxx := Round(FB*(Width/255));
CreateGradient;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
procedure TRAxisColorPicker.Paint;
@ -139,8 +140,70 @@ end;
procedure TRAxisColorPicker.Resize;
begin
FManual := false;
myy := Round((255-FG)*(Height/255));
mxx := Round(FB*(Width/255));
myy := Round((255 - FG) * Height / 255);
mxx := Round(FB * Width / 255);
inherited;
end;
procedure TRAxisColorPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
delta: Integer;
eraseKey: Boolean;
begin
eraseKey := true;
if ssCtrl in Shift then
delta := 10
else
delta := 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;
end;
if eraseKey then Key := 0;
inherited;
end;
@ -153,10 +216,10 @@ begin
myy := y;
if Button = mbLeft then
begin
{$IFDEF DELPHI}
R := ClientRect;
R.TopLeft := ClientToScreen(R.TopLeft);
R.BottomRight := ClientToScreen(R.BottomRight);
{$IFDEF DELPHI}
ClipCursor(@R);
{$ENDIF}
FSelected := GetColorAtPoint(x, y);
@ -169,14 +232,18 @@ end;
procedure TRAxisColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited;
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if ssLeft in Shift then
begin
{$IFDEF DELPHI}
ClipCursor(nil);
{$ENDIF}
mxx := x;
myy := y;
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end;
procedure TRAxisColorPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -189,9 +256,11 @@ begin
FSelected := GetColorAtPoint(x, y);
FManual := true;
Invalidate;
if Assigned(FOnChange) then FOnChange(self);
end;
end;
(*
procedure TRAxisColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -288,7 +357,7 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
procedure TRAxisColorPicker.SetRValue(r: integer);
begin
Clamp(r, 0, 255);

62
components/mbColorLib/SLColorPicker.pas
View File

@ -40,11 +40,12 @@ type
procedure Paint; override;
procedure Resize; override;
procedure CreateWnd; 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 CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
message CN_KEYDOWN;
// procedure CNKeyDown(var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
// message CN_KEYDOWN;
public
constructor Create(AOwner: TComponent); override;
function GetColorAtPoint(x, y: integer): TColor; override;
@ -235,6 +236,61 @@ begin
FChange := true;
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;
case Key of
VK_LEFT:
if (mdx - delta >= 0) then
begin
Dec(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_RIGHT:
if (mdx + delta < Width) then
begin
Inc(mdx, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_UP:
if (mdy - delta >= 0) then
begin
Dec(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
VK_DOWN:
if (mdy + delta < Height) then
begin
Inc(mdy, delta);
SelectionChanged(mdx, mdy);
FManual := true;
if Assigned(FOnChange) then FOnChange(Self);
end;
else
eraseKey := false;
end;
if eraseKey then
Key := 0;
inherited;
end;
procedure TSLColorPicker.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
@ -324,6 +380,7 @@ begin
Result := GetWebSafe(Result);
end;
(*
procedure TSLColorPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF} );
var
@ -382,5 +439,6 @@ begin
if Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
end.

64
components/mbColorLib/SLHColorPicker.pas
View File

@ -62,8 +62,11 @@ type
procedure Paint; override;
// procedure PaintParentBack; override;
procedure Resize; override;
procedure SetFocus; override;
(*
procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF});
message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
*)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -140,6 +143,31 @@ begin
FHCursor := crDefault;
FSLCursor := crDefault;
// Saturation-Lightness picker
FSLPicker := TSLColorPicker.Create(Self);
InsertControl(FSLPicker);
with FSLPicker do
begin
{$IFDEF DELPHI}
Left := 0;
Top := DELTA;
Width := 255;
Height := self.Height - 2 * VDELTA;
{$ELSE}
SetInitialBounds(0, VDELTA, WSL, HSL);
{$ENDIF}
//Anchors := [akLeft, akRight, akTop, akBottom];
Visible := true;
SelectedColor := clRed;
MaxHue := FMaxH;
MaxSaturation := FMaxS;
MaxLuminance := FMaxL;
Saturation := FMaxS;
Luminance := FMaxL;
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
// Hue picker
with FHPicker do
begin
@ -166,30 +194,6 @@ begin
OnMouseMove := DoMouseMove;
end;
// Saturation-Lightness picker
FSLPicker := TSLColorPicker.Create(Self);
InsertControl(FSLPicker);
with FSLPicker do
begin
{$IFDEF DELPHI}
Left := 0;
Top := DELTA;
Width := 255;
Height := self.Height - 2 * VDELTA;
{$ELSE}
SetInitialBounds(0, VDELTA, WSL, HSL);
{$ENDIF}
//Anchors := [akLeft, akRight, akTop, akBottom];
Visible := true;
SelectedColor := clRed;
MaxHue := FMaxH;
MaxSaturation := FMaxS;
MaxLuminance := FMaxL;
Saturation := FMaxS;
Luminance := FMaxL;
OnChange := SLPickerChange;
OnMouseMove := DoMouseMove;
end;
FHValue := 0;
FSValue := 1.0;
FLValue := 1.0;
@ -203,8 +207,8 @@ end;
destructor TSLHColorPicker.Destroy;
begin
PBack.Free;
FHPicker.Free;
FSLPicker.Free;
// FHPicker.Free;
// FSLPicker.Free;
inherited Destroy;
end;
@ -368,12 +372,18 @@ begin
FSLPicker.Cursor := c;
end;
procedure TSLHColorPicker.SetFocus;
begin
FSLPicker.SetFocus;
end;
(*
procedure TSLHColorPicker.WMSetFocus(
var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF} );
begin
FHPicker.SetFocus;
FSLPicker.SetFocus;
Message.Result := 1;
end;
*)
function TSLHColorPicker.GetManual:boolean;
begin

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

@ -58,7 +58,6 @@
</SearchPaths>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>

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

@ -43,9 +43,9 @@ object Form1: TForm1
Height = 384
Top = 6
Width = 403
ActivePage = TabSheet1
ActivePage = TabSheet5
Anchors = [akTop, akLeft, akRight, akBottom]
TabIndex = 0
TabIndex = 4
TabOrder = 0
OnChange = PageControl1Change
OnMouseMove = PageControl1MouseMove
@ -720,9 +720,9 @@ object Form1: TForm1
Anchors = [akLeft, akRight, akBottom]
TabOrder = 2
Hue = 0
Saturation = 51
Saturation = 0
Luminance = 240
SelectedColor = clWhite
SelectedColor = 6579300
end
object VColorPicker1: TVColorPicker
Left = 34
@ -1027,6 +1027,7 @@ object Form1: TForm1
Width = 100
HintFormat = 'G: %g B: %b'#13'Hex: #%hex'
TabOrder = 0
OnChange = RAxisColorPicker1Change
end
object GAxisColorPicker1: TGAxisColorPicker
Left = 130
@ -1036,6 +1037,7 @@ object Form1: TForm1
HintFormat = 'R: %r B: %b'#13'Hex: #%hex'
TabOrder = 1
MarkerStyle = msCross
OnChange = GAxisColorPicker1Change
end
object BAxisColorPicker1: TBAxisColorPicker
Left = 250
@ -1045,11 +1047,12 @@ object Form1: TForm1
HintFormat = 'R: %r G: %g'#13'Hex: #%hex'
TabOrder = 2
MarkerStyle = msCrossCirc
OnChange = BAxisColorPicker1Change
end
object CIELColorPicker1: TCIELColorPicker
Left = 10
Height = 100
Top = 164
Top = 188
Width = 100
SelectedColor = 16119089
HintFormat = 'A: %cieA B: %cieB'#13'Hex: #%hex'
@ -1057,11 +1060,12 @@ object Form1: TForm1
LValue = 88
AValue = -47
BValue = -32
OnChange = CIELColorPicker1Change
end
object CIEAColorPicker1: TCIEAColorPicker
Left = 130
Height = 100
Top = 164
Top = 188
Width = 100
SelectedColor = 16515327
HintFormat = 'L: %cieL B: %cieB'#13'Hex: #%hex'
@ -1070,11 +1074,12 @@ object Form1: TForm1
AValue = 96
BValue = -78
MarkerStyle = msSquare
OnChange = CIEAColorPicker1Change
end
object CIEBColorPicker1: TCIEBColorPicker
Left = 250
Height = 100
Top = 164
Top = 188
Width = 100
SelectedColor = 130823
HintFormat = 'L: %cieL A: %cieA'#13'Hex: #%hex'
@ -1082,6 +1087,7 @@ object Form1: TForm1
LValue = 88
AValue = -88
BValue = 74
OnChange = CIEBColorPicker1Change
end
object Label10: TLabel
Left = 130
@ -1110,7 +1116,7 @@ object Form1: TForm1
object Label13: TLabel
Left = 10
Height = 15
Top = 144
Top = 168
Width = 84
Caption = 'CIELColorPicker'
ParentColor = False
@ -1118,7 +1124,7 @@ object Form1: TForm1
object Label14: TLabel
Left = 130
Height = 15
Top = 144
Top = 168
Width = 86
Caption = 'CIEAColorPicker'
ParentColor = False
@ -1126,11 +1132,47 @@ object Form1: TForm1
object Label15: TLabel
Left = 250
Height = 15
Top = 144
Top = 168
Width = 85
Caption = 'CIEBColorPicker'
ParentColor = False
end
object RAxisIndicator: TShape
Left = 88
Height = 21
Top = 132
Width = 22
end
object GAxisIndicator: TShape
Left = 208
Height = 21
Top = 132
Width = 22
end
object BAxisIndicator: TShape
Left = 328
Height = 21
Top = 132
Width = 22
end
object CIEBIndicator: TShape
Left = 328
Height = 21
Top = 296
Width = 22
end
object CIEAIndicator: TShape
Left = 208
Height = 21
Top = 296
Width = 22
end
object CIELIndicator: TShape
Left = 88
Height = 21
Top = 296
Width = 22
end
end
end
object sc: TmbColorPreview
@ -1182,7 +1224,7 @@ object Form1: TForm1
Anchors = [akTop, akRight]
Caption = 'WebSafe'
OnClick = CbWebSsafeClick
TabOrder = 5
TabOrder = 6
end
object CbSwatchStyle: TCheckBox
Left = 416
@ -1192,7 +1234,7 @@ object Form1: TForm1
Anchors = [akTop, akRight]
Caption = 'SwatchStyle'
OnClick = CbSwatchStyleClick
TabOrder = 6
TabOrder = 5
end
object CbShowHints: TCheckBox
Left = 416

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

@ -5,7 +5,7 @@ interface
uses
LCLIntf, LCLType, LMessages, SysUtils, Variants,Classes, Graphics, Controls,
Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, mbColorPreview,
Forms, Dialogs, HSLColorPicker, ComCtrls, StdCtrls, ExtCtrls, mbColorPreview,
HexaColorPicker, mbColorPalette, HSLRingPicker, HSVColorPicker, PalUtils,
SLHColorPicker, mbDeskPickerButton, mbOfficeColorDialog, SColorPicker,
HColorPicker, VColorPicker, mbTrackBarPicker, LColorPicker, HRingPicker,
@ -20,8 +20,10 @@ type
{ TForm1 }
TForm1 = class(TForm)
CIEBIndicator: TShape;
CbShowHints: TCheckBox;
CbEnabled: TCheckBox;
CIEAIndicator: TShape;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
@ -29,6 +31,10 @@ type
Label14: TLabel;
Label15: TLabel;
PageControl1: TPageControl;
RAxisIndicator: TShape;
GAxisIndicator: TShape;
BAxisIndicator: TShape;
CIELIndicator: TShape;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
@ -105,13 +111,19 @@ type
Memo1: TMemo;
Label9: TLabel;
CbSwatchStyle: TCheckBox;
procedure BAxisColorPicker1Change(Sender: TObject);
procedure CbEnabledChange(Sender: TObject);
procedure CbShowHintsChange(Sender: TObject);
procedure CIEAColorPicker1Change(Sender: TObject);
procedure CIEBColorPicker1Change(Sender: TObject);
procedure CIELColorPicker1Change(Sender: TObject);
procedure GAxisColorPicker1Change(Sender: TObject);
procedure HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer;
var AText: String);
procedure PageControl1Change(Sender: TObject);
procedure PageControl1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure RAxisColorPicker1Change(Sender: TObject);
procedure tb1Change(Sender: TObject);
procedure tb2Change(Sender: TObject);
procedure HSLColorPicker1Change(Sender: TObject);
@ -208,6 +220,11 @@ begin
uc.color := hexacolorpicker1.ColorUnderCursor;
end;
procedure TForm1.BAxisColorPicker1Change(Sender: TObject);
begin
BAxisIndicator.Brush.Color := BAxisColorPicker1.SelectedColor;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
mbColorPalette1.GeneratePalette(clblue);
@ -281,6 +298,11 @@ begin
uc.color := HSLColorpicker1.ColorUnderCursor;
end;
procedure TForm1.RAxisColorPicker1Change(Sender: TObject);
begin
RAxisIndicator.Brush.Color := RAxisColorPicker1.SelectedColor;
end;
procedure TForm1.OfficeColorDialogButtonClick(Sender: TObject);
begin
if mbOfficeColorDialog1.Execute then
@ -341,6 +363,11 @@ begin
end;
end;
procedure TForm1.GAxisColorPicker1Change(Sender: TObject);
begin
GAxisIndicator.Brush.Color := GAxisColorPicker1.SelectedColor;
end;
procedure TForm1.HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer;
var AText: String);
begin
@ -362,6 +389,21 @@ begin
hexacolorpicker1.NewArrowStyle := checkbox2.checked;
end;
procedure TForm1.CIEAColorPicker1Change(Sender: TObject);
begin
CIEAIndicator.Brush.Color := CIEAColorPicker1.SelectedColor;
end;
procedure TForm1.CIEBColorPicker1Change(Sender: TObject);
begin
CIEBIndicator.Brush.Color := CIEBColorPicker1.SelectedColor;
end;
procedure TForm1.CIELColorPicker1Change(Sender: TObject);
begin
CIELIndicator.Brush.Color := CIELColorPicker1.SelectedColor;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if opendialog1.Execute then

6
components/mbColorLib/mbBasicPicker.pas
View File

@ -41,7 +41,6 @@ type
function GetHintStr(X, Y: Integer): String; virtual;
procedure MouseLeave; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function MouseOnPicker(X, Y: Integer): Boolean; virtual;
procedure PaintParentBack; virtual; overload;
procedure PaintParentBack(ACanvas: TCanvas); overload;
procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
@ -243,11 +242,6 @@ begin
}
end;
function TmbBasicPicker.MouseOnPicker(X, Y: Integer): Boolean;
begin
Result := true;
end;
procedure TmbBasicPicker.PaintParentBack;
begin
PaintParentBack(Canvas);

87
components/mbColorLib/mbTrackBarPicker.pas
View File

@ -91,19 +91,20 @@ type
function GetHintPos(X, Y: Integer): TPoint; override;
function GetHintStr(X, Y: Integer): String; override;
function GetSelectedValue: integer; virtual; abstract;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function MouseOnPicker(X, Y: Integer): Boolean; override;
// function MouseOnPicker(X, Y: Integer): Boolean;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
{$IFDEF DELPHI}
procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
// procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
procedure CMGotFocus(var Message: TCMGotFocus); message CM_ENTER;
procedure CMLostFocus(var Message: TCMLostFocus); message CM_EXIT;
{$ELSE}
procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
// procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
procedure CMGotFocus(var Message: TLMessage); message CM_ENTER;
procedure CMLostFocus(var Message: TLMessage); message CM_EXIT;
{$ENDIF}
@ -608,6 +609,78 @@ begin
Result := pos;
end;
procedure TmbTrackBarPicker.KeyDown(var Key: Word; Shift: TShiftState);
var
eraseKey: Boolean;
begin
eraseKey := true;
case Key of
VK_UP:
if FLayout = lyHorizontal then
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(FOnChange) then FOnChange(Self);
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(FOnChange) then FOnChange(Self);
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(FOnChange) then FOnChange(Self);
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(FOnChange) then FOnChange(Self);
end
else
eraseKey := false;
end; // case
if eraseKey then
Key := 0;
inherited;
end;
procedure TmbTrackBarPicker.MouseLeave;
begin
inherited;
@ -639,11 +712,11 @@ begin
end;
inherited;
end;
(*
function TmbTrackBarPicker.MouseOnPicker(X, Y: Integer): Boolean;
begin
Result := PtInRect(FPickRect, Point(X, Y));
end;
end; *)
procedure TmbTrackBarPicker.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
@ -681,7 +754,7 @@ begin
Invalidate;
inherited;
end;
(*
procedure TmbTrackBarPicker.CNKeyDown(
var Message: {$IFDEF FPC}TLMKeyDown{$ELSE}TWMKeyDown{$ENDIF});
var
@ -764,7 +837,7 @@ begin
if not FInherited and Assigned(OnKeyDown) then
OnKeyDown(Self, Message.CharCode, Shift);
end;
*)
function TmbTrackBarPicker.GetHintPos(X, Y: Integer): TPoint;
begin
case FLayout of