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

fixed: do not call KeyPress handling for alt-<x> keys (CN_SYSCHAR, WM_SYSCHAR)

Browse Source 
fixed: handle tab when pressing the key, not when releasing it (seems platform independent)
fixed: remove tab handling in combobox
fixed: move dialogchar handling to pre-interface, so that widgetset can "ding" when key was not handled

git-svn-id: trunk@7543 -
This commit is contained in:
micha 2005-08-22 12:49:55 +00:00
parent 924eb93413
commit 91d33a67f4
8 changed files with 45 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/controls.pp
View File

@ -1451,7 +1451,6 @@ type
procedure WMKeyUp(var Message: TLMKeyUp); message LM_KEYUP;
procedure WMSysKeyUp(var Message: TLMKeyUp); message LM_SYSKEYUP;
procedure WMChar(var Message: TLMChar); message LM_CHAR;
procedure WMSysChar(var Message: TLMChar); message LM_SYSCHAR;
procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
procedure WMDestroy(var Message: TLMDestroy); message LM_DESTROY;
procedure WMMove(var Message: TLMMove); message LM_MOVE;
@ -1486,12 +1485,12 @@ type
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic;
function DoKeyDownBeforeInterface(var Message: TLMKey): Boolean;
function DoRemainingKeyDown(var Message: TLMKeyDown): Boolean;
function DoRemainingKeyPress(var Message: TLMKey): Boolean;
function DoRemainingKeyUp(var Message: TLMKeyDown): Boolean;
function DoKeyPress(var Message: TLMKey): Boolean;
function DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; dynamic;
function DoKeyUpBeforeInterface(var Message: TLMKey): Boolean;
function ChildKey(var Message: TLMKey): boolean; dynamic;
function SendDialogChar(var Message: TLMKey): Boolean;
function DialogChar(var Message: TLMKey): boolean; override;
procedure ControlKeyDown(var Key: Word; Shift: TShiftState); dynamic;
procedure ControlKeyUp(var Key: Word; Shift: TShiftState); dynamic;

4
lcl/include/application.inc
View File

@ -1204,6 +1204,9 @@ begin
if AControl=nil then ;
//debugln('TApplication.ControlKeyDown A ',DbgSName(AControl));
FLastKeyDownSender:=AControl;
// handle navigation key
DoTabKey(AControl, Key, Shift);
end else
FLastKeyDownSender:=nil;
FLastKeyDownKey:=Key;
@ -1233,7 +1236,6 @@ begin
end;
// handle special navigation keys
DoTabKey(AControl, Key, Shift);
DoReturnKey(AControl, Key, Shift);
DoEscapeKey(AControl, Key, Shift);
end;

6
lcl/include/customcombobox.inc
View File

@ -437,12 +437,6 @@ begin
inherited KeyDown(Key, Shift);
end;
procedure TCustomComboBox.ControlKeyDown(var Key: Word; Shift: TShiftState);
begin
if Application<>nil then Application.DoTabKey(Self,Key,Shift);
inherited ControlKeyDown(Key, Shift);
end;
{------------------------------------------------------------------------------
function TCustomComboBox.SelectItem(const AnItem: String): Boolean;

6
lcl/include/customedit.inc
View File

@ -314,12 +314,6 @@ begin
Result:=false;
end;
procedure TCustomEdit.ControlKeyDown(var Key: Word; Shift: TShiftState);
begin
if Application<>nil then Application.DoTabKey(Self,Key,Shift);
inherited ControlKeyDown(Key, Shift);
end;
procedure TCustomEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited KeyUp(Key, Shift);

34
lcl/include/wincontrol.inc
View File

@ -2677,7 +2677,7 @@ End;
Returns True if key handled
------------------------------------------------------------------------------}
function TWinControl.DoRemainingKeyPress(var Message : TLMKey): Boolean;
function TWinControl.SendDialogChar(var Message : TLMKey): Boolean;
var
ParentForm: TCustomForm;
begin
@ -2685,7 +2685,11 @@ begin
if ParentForm <> nil then
begin
Result := ParentForm.DialogChar(Message);
if Result then exit;
if Result then
begin
Message.CharCode := VK_UNKNOWN;
exit;
end;
end;
end;
@ -3616,7 +3620,10 @@ end;
procedure TWinControl.CNSysChar(var Message: TLMKeyUp);
begin
if not DoKeyPress(Message) then {inherited}; // there is nothing to inherit
if SendDialogChar(Message) then
Message.Result := 1
else
{inherited}; // there is nothing to inherit
end;
{------------------------------------------------------------------------------
@ -3716,18 +3723,11 @@ end;
procedure TWinControl.WMChar(var Message: TLMChar);
begin
//debugln('TWinControl.WMChar ',DbgSName(Self),' ',dbgs(Message.CharCode));
if DoRemainingKeyPress(Message) then
if SendDialogChar(Message) then
Message.Result := 1;
Assert(False, Format('Trace:[TWinControl.WMChar] %s', [ClassName]));
end;
procedure TWinControl.WMSysChar(var Message: TLMChar);
begin
//debugln('TWinControl.WMSysChar ',DbgSName(Self),' ',dbgs(Message.CharCode));
if DoRemainingKeyPress(Message) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------
Method: TWinControl.WMKeyDown
Params: Msg: The message
@ -3737,12 +3737,14 @@ end;
------------------------------------------------------------------------------}
Procedure TWinControl.WMKeyDown(Var Message: TLMKeyDown);
begin
DoRemainingKeyDown(Message);
if DoRemainingKeyDown(Message) then
Message.Result := 1;
end;
procedure TWinControl.WMSysKeyDown(var Message: TLMKeyDown);
begin
DoRemainingKeyDown(Message);
if DoRemainingKeyDown(Message) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------
@ -3751,7 +3753,8 @@ end;
procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp);
begin
//debugln('TWinControl.WMSysKeyUp ',DbgSName(Self));
DoRemainingKeyUp(Message);
if DoRemainingKeyUp(Message) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------
@ -3764,7 +3767,8 @@ end;
Procedure TWinControl.WMKeyUp(Var Message: TLMKeyUp);
begin
//debugln('TWinControl.WMKeyUp ',DbgSName(Self));
DoRemainingKeyUp(Message);
if DoRemainingKeyUp(Message) then
Message.Result := 1;
end;
{------------------------------------------------------------------------------

26
lcl/interfaces/win32/win32callback.inc
View File

@ -522,6 +522,14 @@ Begin
end else begin
lWinControl := WindowInfo^.WinControl;
end;
if WindowInfo^.ignoreNextChar and ((Msg = WM_CHAR) or (Msg = WM_SYSCHAR)) then
begin
WindowInfo^.ignoreNextChar := false;
Result := 1;
exit;
end;
Assert(False, 'Trace:WindowProc - Getting Callback Object');
Assert(False, 'Trace:WindowProc - Checking Proc');
@ -1214,11 +1222,12 @@ Begin
PLMsg:=@LMKey;
With LMKey Do
Begin
Msg := LM_SYSKEYDOWN;
Msg := CN_SYSKEYDOWN;
KeyData := LParam;
CharCode := Word(WParam);
Result := 0;
End;
WinProcess := false;
End;
WM_SYSKEYUP:
Begin
@ -1226,11 +1235,12 @@ Begin
PLMsg:=@LMKey;
With LMKey Do
Begin
Msg := LM_SYSKEYUP;
Msg := CN_SYSKEYUP;
KeyData := LParam;
CharCode := Word(WParam);
Result := 0;
End;
WinProcess := false;
End;
WM_TIMER:
Begin
@ -1400,14 +1410,14 @@ Begin
CN_CHAR, CN_SYSCHAR:
begin
// if key not yet processed, let windows process it
WinProcess := LMChar.CharCode <> VK_UNKNOWN;
WinProcess := (LMChar.CharCode <> VK_UNKNOWN) and (LMChar.Result = 0);
WParam := LMChar.CharCode;
end;
CN_KEYDOWN, CN_KEYUP, CN_SYSKEYDOWN, CN_SYSKEYUP:
begin
// if key not yet processed, let windows process it
WinProcess := LMKey.CharCode <> VK_UNKNOWN;
WinProcess := (LMKey.CharCode <> VK_UNKNOWN) and (LMChar.Result = 0);
WParam := LMKey.CharCode;
end;
@ -1489,7 +1499,13 @@ Begin
Windows.SendMessage(Window, EM_SETSEL, 0, -1);
end;
end;
end;
// ignore WM_(SYS)CHAR message if LCL handled WM_(SYS)KEYDOWN
if ((PLMsg^.Msg = WM_KEYDOWN) or (PLMsg^.Msg = WM_SYSKEYDOWN))
and (WindowInfo <> @DefaultWindowInfo)
and (PLMsg^.Result <> 0) then
WindowInfo^.ignoreNextChar := true;
end;
end;
end;

1
lcl/interfaces/win32/win32proc.pp
View File

@ -50,6 +50,7 @@ Type
isComboEdit: boolean; // is buddy of combobox, the edit control
isChildEdit: boolean; // is buddy of combobox, the edit control
isGroupBox: boolean; // is groupbox, and does not have themed tabpage as parent
ignoreNextChar: boolean; // ignore next WM_(SYS)CHAR message
MaxLength: dword;
MouseX, MouseY: word; // noticing spurious WM_MOUSEMOVE messages
end;

2
lcl/stdctrls.pp
View File

@ -287,7 +287,6 @@ type
procedure SetStyle(Val: TComboBoxStyle); virtual;
procedure RealSetText(const AValue: TCaption); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override;
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
@ -599,7 +598,6 @@ type
procedure SetSelText(const Val: string); virtual;
procedure RealSetText(const Value: TCaption); override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
procedure WMChar(var Message: TLMChar); message LM_CHAR;
public