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

lcl: don't allow LCL to handle arrow keys of TCustomEdit descendants (fixes bug #0022191), handle WantTabs and WantReturn of TCustomMemo inside CM_WANTSPECIALKEY handler

Browse Source 
git-svn-id: trunk@37689 -
This commit is contained in:
paul 2012-06-19 01:17:25 +00:00
parent 29485dc359
commit 68d65a2b2c
4 changed files with 21 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/include/customedit.inc
View File

@ -454,6 +454,15 @@ begin
inherited WMChar(Message); inherited WMChar(Message);
end; end;
procedure TCustomEdit.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin
// don't allow LCL to handle arrow keys for edit controls
if Message.CharCode in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN] then
Message.Result := 1
else
inherited;
end;
procedure TCustomEdit.MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); procedure TCustomEdit.MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer);
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);

25
lcl/include/custommemo.inc
View File

@ -256,26 +256,13 @@ begin
end; end;
end; end;
procedure TCustomMemo.ControlKeyDown(var Key: Word; Shift: TShiftState); procedure TCustomMemo.CMWantSpecialKey(var Message: TCMWantSpecialKey);
begin begin
if not ReadOnly then case Message.CharCode of
begin VK_RETURN: if WantReturns then Message.Result := 1;
if FWantReturns and (Key=VK_RETURN) and (Shift=[]) then VK_TAB: if WantTabs then Message.Result := 1;
exit; else
if FWantTabs and (Key=VK_TAB) and (Shift-[ssShift]=[]) then inherited;
exit;
end;
inherited ControlKeyDown(Key, Shift);
end;
procedure TCustomMemo.CNChar(var Message: TLMKeyUp);
begin
inherited CNChar(Message);
if not FWantReturns and (Message.CharCode = VK_RETURN) then
begin
Message.CharCode := VK_UNKNOWN;
Message.Result := 1;
end; end;
end; end;

1
lcl/lmessages.pp
View File

@ -452,6 +452,7 @@ type
TLMSysChar = TLMKey; TLMSysChar = TLMKey;
TLMSysKeyDown = TLMKey; TLMSysKeyDown = TLMKey;
TLMSysKeyUp = TLMKey; TLMSysKeyUp = TLMKey;
TCMWantSpecialKey = TLMKey;
TLMCut = TLMNoParams; TLMCut = TLMNoParams;

9
lcl/stdctrls.pp
View File

@ -734,10 +734,12 @@ type
procedure SetSelText(const Val: string); virtual; procedure SetSelText(const Val: string); virtual;
function ChildClassAllowed(ChildClass: TClass): boolean; override; function ChildClassAllowed(ChildClass: TClass): boolean; override;
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
procedure WMChar(var Message: TLMChar); message LM_CHAR;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
procedure RealSetText(const AValue: TCaption); override; procedure RealSetText(const AValue: TCaption); override;
procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
procedure WMChar(var Message: TLMChar); message LM_CHAR;
procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True; property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
property AutoSelected: Boolean read FAutoSelected write FAutoSelected; property AutoSelected: Boolean read FAutoSelected write FAutoSelected;
property ParentColor default False; property ParentColor default False;
@ -821,8 +823,7 @@ type
procedure SetWordWrap(const Value: boolean); procedure SetWordWrap(const Value: boolean);
procedure SetScrollBars(const Value: TScrollStyle); procedure SetScrollBars(const Value: TScrollStyle);
procedure Loaded; override; procedure Loaded; override;
procedure ControlKeyDown(var Key: Word; Shift: TShiftState); override; procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure CNChar(var Message: TLMKeyUp); message CN_CHAR;
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;