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

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