paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-11 12:19:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@18461 -
This commit is contained in:
paul 2009-01-27 09:05:42 +00:00
parent 5980abdcec
commit 75fcdb8abe
6 changed files with 53 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

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

8
lcl/forms.pp
View File

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

30
lcl/include/application.inc
View File

@ -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])=[])
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;

6
lcl/include/buttoncontrol.inc
View File

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

9
lcl/include/control.inc
View File

@ -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

1
lcl/stdctrls.pp
View File

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