paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: always ask control about special key using CM_WANTSPECIALKEY and LM_GETDLGCODE, simplify DoCancelKey, DoReturnKey, remove old WantKeyBeforeInterface

Browse Source 
git-svn-id: trunk@37142 -
This commit is contained in:
paul 2012-05-03 01:38:51 +00:00
parent c40f7cfc8e
commit 70fca72696
4 changed files with 47 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -1889,7 +1889,6 @@ type
procedure SetTabStop(NewTabStop: Boolean);
procedure SetUseDockManager(const AValue: Boolean);
procedure UpdateTabOrder(NewTabOrder: TTabOrder);
function WantsKeyBeforeInterface(Key: word; Shift: TShiftState): boolean;
procedure Insert(AControl: TControl);
procedure Insert(AControl: TControl; Index: integer);
procedure Remove(AControl: TControl);

4
lcl/forms.pp
View File

@ -1461,10 +1461,12 @@ type
function IsRTLLang(ALang: String): Boolean;
function Direction(ALang: String): TBiDiMode;
public
// on key down
procedure DoArrowKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
procedure DoTabKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
// on key up
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);
property Active: boolean read GetActive;
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;

81
lcl/include/application.inc
View File

@ -1671,7 +1671,8 @@ begin
// handle navigation key
DoTabKey(AControl, Key, Shift);
DoArrowKey(AControl, Key, Shift);
end else
end
else
FLastKeyDownSender := nil;
//DebugLn(['TApplication.ControlKeyDown Sender=',DbgSName(Sender),' Key=',Key,' Shift=',dbgs(Shift)]);
FLastKeyDownKey := Key;
@ -1683,21 +1684,23 @@ procedure TApplication.ControlKeyUp(Sender: TObject; var Key: Word;
var
AControl: TWinControl;
begin
if Key=VK_UNKNOWN then exit;
if Key = VK_UNKNOWN then exit;
if Sender is TWinControl then begin
AControl:=TWinControl(Sender);
if Sender is TWinControl then
begin
AControl := TWinControl(Sender);
//debugln('TApplication.ControlKeyUp A ',DbgSName(AControl),' Key=',dbgs(Key),' Shift=',dbgs(Shift));
if FLastKeyDownKey=VK_UNKNOWN then begin
if FLastKeyDownKey = VK_UNKNOWN then
begin
// key was already handled in key down
//debugln('TApplication.ControlKeyUp key was handled in key down');
exit;
Exit;
end;
if (Key<>FLastKeyDownKey) or (Shift<>FLastKeyDownShift)
or (AControl<>FLastKeyDownSender) then begin
if (Key <> FLastKeyDownKey) or (Shift <> FLastKeyDownShift) or (AControl <> FLastKeyDownSender) then
begin
// a key up, without key down
//debugln('TApplication.ControlKeyUp key was handled in key down or in key up');
exit;
Exit;
end;
// handle special navigation keys
@ -2021,9 +2024,10 @@ 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
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
(AControl.Perform(LM_GETDLGCODE, 0, 0) and DLGC_WANTARROWS = 0) and
(anoArrowToSelectNextInParent in Navigation) and AControl.Focused and
(AControl.Parent <> nil) and
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
Assigned(AControl.Parent) then
begin
// traverse controls inside parent
AControl.Parent.SelectNext(AControl, Key in [VK_RIGHT, VK_DOWN], False);
@ -2079,17 +2083,17 @@ procedure TApplication.DoEscapeKey(AControl: TWinControl; var Key: Word;
var
Form: TCustomForm;
begin
if (Shift = []) and (Key = VK_ESCAPE) then begin
if (Shift = []) and (Key = VK_ESCAPE) and
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
(AControl.Perform(LM_GETDLGCODE, 0, 0) and DLGC_WANTALLKEYS = 0) and
(anoEscapeForCancelControl in Navigation) then
begin
Form := GetParentForm(AControl);
if Form<>nil then begin
if (anoEscapeForCancelControl in Navigation) then begin
if (Form.CancelControl <> nil) then
begin
//debugln('TApplication.ControlKeyUp VK_ESCAPE ', Acontrol.Name);
Form.CancelControl.ExecuteCancelAction;
Key := VK_UNKNOWN;
end;
end;
if Assigned(Form) and Assigned(Form.CancelControl) then
begin
//debugln('TApplication.ControlKeyUp VK_ESCAPE ', Acontrol.Name);
Form.CancelControl.ExecuteCancelAction;
Key := VK_UNKNOWN;
end;
end;
end;
@ -2100,23 +2104,25 @@ var
Form: TCustomForm;
lDefaultControl: TControl;
begin
if (Shift = []) and (Key = VK_RETURN) then begin
if (Shift = []) and (Key = VK_RETURN) and
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
(AControl.Perform(LM_GETDLGCODE, 0, 0) and DLGC_WANTALLKEYS = 0) and
(anoReturnForDefaultControl in Navigation) then
begin
//DebugLn(['TApplication.DoReturnKey ',DbgSName(AControl)]);
Form := GetParentForm(AControl);
if Form<>nil then begin
if anoReturnForDefaultControl in Navigation then
if Assigned(Form) then
begin
lDefaultControl := Form.ActiveDefaultControl;
if lDefaultControl = nil then
lDefaultControl := Form.DefaultControl;
if Assigned(lDefaultControl)
and ((lDefaultControl.Parent = nil) or (lDefaultControl.Parent.CanFocus))
and lDefaultControl.Enabled and lDefaultControl.Visible then
begin
lDefaultControl := Form.ActiveDefaultControl;
if lDefaultControl = nil then
lDefaultControl := Form.DefaultControl;
if (lDefaultControl <> nil)
and ((lDefaultControl.Parent = nil) or (lDefaultControl.Parent.CanFocus))
and lDefaultControl.Enabled and lDefaultControl.Visible then
begin
//debugln('TApplication.ControlKeyUp VK_RETURN ', Acontrol.Name);
lDefaultControl.ExecuteDefaultAction;
Key := VK_UNKNOWN;
end;
//debugln('TApplication.ControlKeyUp VK_RETURN ', Acontrol.Name);
lDefaultControl.ExecuteDefaultAction;
Key := VK_UNKNOWN;
end;
end;
end;
@ -2126,8 +2132,9 @@ 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 and
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) then
(AControl.Perform(CM_WANTSPECIALKEY, Key, 0) = 0) and
(AControl.Perform(LM_GETDLGCODE, 0, 0) and DLGC_WANTTAB = 0) and
(anoTabToSelectNext in Navigation) and AControl.Focused then
begin
// traverse tabstop controls inside form
AControl.PerformTab(not (ssShift in Shift));

40
lcl/include/wincontrol.inc
View File

@ -5585,46 +5585,6 @@ begin
//debugln('TWinControl.KeyUpAfterInterface ',DbgSName(Self));
end;
{------------------------------------------------------------------------------
Method: TWinControl.WantsKey
Params: CharCode - the key to inspect whether it is wanted
Returns: true if key is wanted before the interface handles it.
Checks if control wants the passed key to handle before the interface.
------------------------------------------------------------------------------}
function TWinControl.WantsKeyBeforeInterface(Key: word; Shift: TShiftState
): boolean;
var
lWantKeys: dword;
{ values for lWantKeys
0 - if not wanted
1 - if wanted, but is special (arrow)
2 - if wanted, but is special (tab)
4 - if wanted, but is special (all)
8 - if wanted, is normal key
}
begin
// For Delphi compatibility we send a LM_GETDLGCODE message to the control
// asking if it wants to handle the key.
// We don't define a default handler for LM_GETDLGCODE,
// so the default return is 0.
// Note: Contrary to Delphi/win32api, we don't know what keys are special,
// different widgetsets may have different sets of special keys;
lWantKeys := Perform(LM_GETDLGCODE, 0, 0);
if (lWantKeys and DLGC_WANTALLKEYS) <> 0 then
begin
lWantKeys := DLGC_WANTALLKEYS;
end else begin
case Key of
VK_TAB:
lWantKeys := lWantKeys and DLGC_WANTTAB;
VK_UP, VK_LEFT, VK_DOWN, VK_RIGHT:
lWantKeys := lWantKeys and DLGC_WANTARROWS;
end;
end;
Result := (lWantKeys<>0);
end;
{------------------------------------------------------------------------------
TWinControl DoKeyDownBeforeInterface