From 75fcdb8abe97669c38b3e03aca701093bfbe075f Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 27 Jan 2009 09:05:42 +0000 Subject: [PATCH] lcl: initial support for arrow keys, handle CM_WANTSPECIALKEY for tabs and arrows git-svn-id: trunk@18461 - --- lcl/controls.pp | 1 + lcl/forms.pp | 12 +++++++---- lcl/include/application.inc | 40 ++++++++++++++++++++++++----------- lcl/include/buttoncontrol.inc | 6 ++++++ lcl/include/control.inc | 9 ++++++++ lcl/stdctrls.pp | 1 + 6 files changed, 53 insertions(+), 16 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 3fd016d3de..293212f3d7 100644 --- a/lcl/controls.pp +++ b/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; diff --git a/lcl/forms.pp b/lcl/forms.pp index f73679f689..277e163cbd 100644 --- a/lcl/forms.pp +++ b/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); + Shift: TShiftState); procedure DoReturnKey(AControl: TWinControl; var Key: Word; - Shift: TShiftState); - procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState); + Shift: TShiftState); + procedure DoTabKey(AControl: TWinControl; var Key: Word; + Shift: TShiftState); property Active: boolean read GetActive; property ApplicationType : TApplicationType read FApplicationType write FApplicationType; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 4caddcf4ea..ba66874e08 100644 --- a/lcl/include/application.inc +++ b/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,19 +1445,20 @@ procedure TApplication.ControlKeyDown(Sender: TObject; var Key: Word; var AControl: TWinControl; begin - if Sender is TWinControl then begin - AControl:=TWinControl(Sender); - if AControl=nil then ; + if Sender is TWinControl then + begin + AControl := TWinControl(Sender); //debugln('TApplication.ControlKeyDown A ',DbgSName(AControl)); - FLastKeyDownSender:=AControl; + FLastKeyDownSender := AControl; // handle navigation key DoTabKey(AControl, Key, Shift); + DoArrowKey(AControl, Key, Shift); end else - FLastKeyDownSender:=nil; + FLastKeyDownSender := nil; //DebugLn(['TApplication.ControlKeyDown Sender=',DbgSName(Sender),' Key=',Key,' Shift=',dbgs(Shift)]); - FLastKeyDownKey:=Key; - FLastKeyDownShift:=Shift; + FLastKeyDownKey := Key; + FLastKeyDownShift := Shift; end; procedure TApplication.ControlKeyUp(Sender: TObject; var Key: Word; @@ -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])=[]) - and (anoTabToSelectNext in Navigation) - and AControl.Focused then + if (Key = VK_TAB) and ((Shift - [ssShift]) = []) and + (anoTabToSelectNext in Navigation) and AControl.Focused and + (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; diff --git a/lcl/include/buttoncontrol.inc b/lcl/include/buttoncontrol.inc index aa39ddd700..f8267f8f2d 100644 --- a/lcl/include/buttoncontrol.inc +++ b/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; diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 052d39e955..d08a6008f7 100644 --- a/lcl/include/control.inc +++ b/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 diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index 98d8ee5eba..ceced68f2e 100644 --- a/lcl/stdctrls.pp +++ b/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;