lcl: initial support for arrow keys, handle CM_WANTSPECIALKEY for tabs and arrows

git-svn-id: trunk@18461 -

lcl/controls.pp

@@ -1029,6 +1029,7 @@ type
     procedure CMParentShowHintChanged(var Message: TLMessage); message CM_PARENTSHOWHINTCHANGED;
     procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
     procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
+    procedure CMWantSpecialKey(var Message: TLMessage); message CM_WANTSPECIALKEY;
   protected
     // drag and drop
     procedure CalculateDockSizes;

lcl/forms.pp

@@ -930,7 +930,8 @@ type
     anoTabToSelectNext,
     anoReturnForDefaultControl,
     anoEscapeForCancelControl,
-    anoF1ForHelp
+    anoF1ForHelp,
+    anoArrowToSelectNextInParent
     );
   TApplicationNavigationOptions = set of TApplicationNavigationOption;
 
@@ -1160,11 +1161,14 @@ type
     procedure IntfAppRestore;
     procedure IntfDropFiles(const FileNames: Array of String);
   public
+    procedure DoArrowKey(AControl: TWinControl; var Key: Word;
+      Shift: TShiftState);
     procedure DoEscapeKey(AControl: TWinControl; var Key: Word;
       Shift: TShiftState);
     procedure DoReturnKey(AControl: TWinControl; var Key: Word;
       Shift: TShiftState);
-    procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState);
+    procedure DoTabKey(AControl: TWinControl; var Key: Word;
+      Shift: TShiftState);
 
     property Active: boolean read GetActive;
     property ApplicationType : TApplicationType read FApplicationType write FApplicationType;

lcl/include/application.inc

@@ -118,7 +118,7 @@ begin
   FIcon := TIcon.Create;
   FIcon.OnChange := @IconChanged;
   FNavigation := [anoTabToSelectNext,anoReturnForDefaultControl,
-                  anoEscapeForCancelControl,anoF1ForHelp];
+                  anoEscapeForCancelControl,anoF1ForHelp,anoArrowToSelectNextInParent];
   ApplicationActionComponent:=Self;
   OnMenuPopupHandler:=@MenuPopupHandler;
 
@@ -1445,14 +1445,15 @@ procedure TApplication.ControlKeyDown(Sender: TObject; var Key: Word;
 var
   AControl: TWinControl;
 begin
-  if Sender is TWinControl then begin
+  if Sender is TWinControl then
+  begin
     AControl := TWinControl(Sender);
-    if AControl=nil then ;
     //debugln('TApplication.ControlKeyDown A ',DbgSName(AControl));
     FLastKeyDownSender := AControl;
 
     // handle navigation key
     DoTabKey(AControl, Key, Shift);
+    DoArrowKey(AControl, Key, Shift);
   end else
     FLastKeyDownSender := nil;
   //DebugLn(['TApplication.ControlKeyDown Sender=',DbgSName(Sender),' Key=',Key,' Shift=',dbgs(Shift)]);
@@ -1730,6 +1731,20 @@ begin
     TDropFilesEvent(FApplicationHandlers[ahtDropFiles][i])(Self,Filenames);
 end;
 
+procedure TApplication.DoArrowKey(AControl: TWinControl; var Key: Word;
+  Shift: TShiftState);
+begin
+  if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) and (Shift = []) and
+     (anoArrowToSelectNextInParent in Navigation) and AControl.Focused and
+     (AControl.Parent <> nil) and
+     (AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
+  begin
+    // traverse controls inside parent
+    AControl.Parent.SelectNext(AControl, Key in [VK_RIGHT, VK_DOWN], False);
+    Key := VK_UNKNOWN;
+  end;
+end;
+
 {------------------------------------------------------------------------------
   procedure TApplication.DoBeforeMouseMessage(CurMouseControl: TControl);
 ------------------------------------------------------------------------------}
@@ -1823,12 +1838,13 @@ end;
 procedure TApplication.DoTabKey(AControl: TWinControl; var Key: Word;
   Shift: TShiftState);
 begin
-  if (Key=VK_Tab) and ((Shift-[ssShift])=[])
+  if (Key = VK_TAB) and ((Shift - [ssShift]) = []) and
-  and (anoTabToSelectNext in Navigation)
+     (anoTabToSelectNext in Navigation) and AControl.Focused and
-  and AControl.Focused then
+     (AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
   begin
-    Key:=VK_UNKNOWN;
+    // traverse tabstop controls inside form
     AControl.PerformTab(not (ssShift in Shift));
+    Key := VK_UNKNOWN;
   end;
 end;
 

lcl/include/buttoncontrol.inc

@@ -51,6 +51,12 @@ begin
   fLastCheckedOnChange:=Checked;
 end;
 
+procedure TButtonControl.CMWantSpecialKey(var Message: TLMessage);
+begin
+  // button controls dont want any special keys
+  Message.Result := 0;
+end;
+
 procedure TButtonControl.Click;
 begin
   DoOnChange;

lcl/include/control.inc

@@ -708,6 +708,15 @@ begin
   TextChanged;
 end;
 
+procedure TControl.CMWantSpecialKey(var Message: TLMessage);
+begin
+  // by default control does not want to handle VK_TAB itself
+  if Message.wParam = VK_TAB then
+    Message.Result := 0
+  else
+    Message.Result := 1;
+end;
+
 {------------------------------------------------------------------------------
        TControl.CMParentColorChanged
 

lcl/stdctrls.pp

@@ -1017,6 +1017,7 @@ type
     procedure Click; override;
     function ColorIsStored: boolean; override;
     procedure Loaded; override;
+    procedure CMWantSpecialKey(var Message: TLMessage); message CM_WANTSPECIALKEY;
   protected
     property Checked: Boolean read GetChecked write SetChecked stored IsCheckedStored default False;
     property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;