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

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);