From dd0594c20b09dbd63f85e1cbf815dd5ce2d6a595 Mon Sep 17 00:00:00 2001 From: dmitry Date: Sun, 5 Aug 2018 07:31:24 +0000 Subject: [PATCH] cocoa: revise keyboard handling. Added support for LM_GETDLGCODE message processing (that queries cocoa controls). Allow arrows navigation is listview git-svn-id: trunk@58677 - --- lcl/interfaces/cocoa/cocoaprivate.pp | 14 + lcl/interfaces/cocoa/cocoatables.pas | 37 ++- lcl/interfaces/cocoa/cocoawinapi.inc | 33 +++ lcl/interfaces/cocoa/cocoawinapih.inc | 1 + lcl/interfaces/cocoa/cocoawscommon.pas | 340 +++++++++++++++++++++++++ 5 files changed, 420 insertions(+), 5 deletions(-) diff --git a/lcl/interfaces/cocoa/cocoaprivate.pp b/lcl/interfaces/cocoa/cocoaprivate.pp index 19d352622b..fe6d6245dc 100644 --- a/lcl/interfaces/cocoa/cocoaprivate.pp +++ b/lcl/interfaces/cocoa/cocoaprivate.pp @@ -51,6 +51,11 @@ type procedure MouseClick; function MouseMove(Event: NSEvent): Boolean; function KeyEvent(Event: NSEvent; AForceAsKeyDown: Boolean = False): Boolean; + + procedure KeyEvPrepare(Event: NSEvent; AForceAsKeyDown: Boolean = False); + procedure KeyEvBefore(var AllowCocoaHandle: boolean); + procedure KeyEvAfter; + function scrollWheel(Event: NSEvent): Boolean; // size, pos events procedure frameDidChange(sender: id); @@ -111,6 +116,7 @@ type function lclIsHandle: Boolean; message 'lclIsHandle'; function lclContentView: NSView; message 'lclContentView'; procedure lclOffsetMousePos(var Point: NSPoint); message 'lclOffsetMousePos:'; + procedure lclExpectedKeys(var wantTabs, wantArrows, wantAll: Boolean); message 'lclExpectedKeys:::'; end; { LCLViewExtension } @@ -773,6 +779,14 @@ begin end; +procedure LCLObjectExtension.lclExpectedKeys(var wantTabs, wantArrows, + wantAll: Boolean); +begin + wantTabs := false; + wantArrows := false; + wantAll := false; +end; + { LCLControlExtension } function RectToViewCoord(view: NSView; const r: TRect): NSRect; diff --git a/lcl/interfaces/cocoa/cocoatables.pas b/lcl/interfaces/cocoa/cocoatables.pas index e8590e1788..33b4e27208 100644 --- a/lcl/interfaces/cocoa/cocoatables.pas +++ b/lcl/interfaces/cocoa/cocoatables.pas @@ -187,6 +187,7 @@ type procedure keyDown(event: NSEvent); override; procedure keyUp(event: NSEvent); override; function lclIsHandle: Boolean; override; + procedure lclExpectedKeys(var wantTabs, wantKeys, wantAllKeys: Boolean); override; // NSTableViewDataSourceProtocol function numberOfRowsInTableView(tableView: NSTableView): NSInteger; message 'numberOfRowsInTableView:'; @@ -558,6 +559,14 @@ begin Result:=true; end; +procedure TCocoaTableListView.lclExpectedKeys(var wantTabs, wantKeys, + wantAllKeys: Boolean); +begin + wantTabs := false; + wantKeys := true; + wantAllKeys := false; +end; + function TCocoaTableListView.acceptsFirstResponder: Boolean; begin Result := True; @@ -691,7 +700,7 @@ begin reloadDataForRowIndexes_columnIndexes(lRowSet, lColSet); end; -procedure TCocoaTableListView.scheduleSelectionDidChange; +procedure TCocoaTableListView.scheduleSelectionDidChange(); begin if Timer = nil then Timer := TTimer.Create(nil); Timer.Interval := 1; @@ -751,15 +760,33 @@ begin end; procedure TCocoaTableListView.keyDown(event: NSEvent); +var + allow : Boolean; begin - if not Assigned(callback) or not callback.KeyEvent(event) then - inherited keyDown(event); + if not Assigned(callback) then + inherited keyDown(event) + else + begin + callback.KeyEvPrepare(event); + callback.KeyEvBefore(allow); + if allow then inherited KeyDown(event); + callback.KeyEvAfter; + end; end; procedure TCocoaTableListView.keyUp(event: NSEvent); +var + allow : Boolean; begin - if not Assigned(callback) or not callback.KeyEvent(event) then - inherited keyUp(event); + if not Assigned(callback) then + inherited KeyUp(event) + else + begin + callback.KeyEvPrepare(event); + callback.KeyEvBefore(allow); + if allow then inherited KeyUp(event); + callback.KeyEvAfter; + end; end; function TCocoaTableListView.numberOfRowsInTableView(tableView: NSTableView diff --git a/lcl/interfaces/cocoa/cocoawinapi.inc b/lcl/interfaces/cocoa/cocoawinapi.inc index fdd3e9436d..33da6991d3 100644 --- a/lcl/interfaces/cocoa/cocoawinapi.inc +++ b/lcl/interfaces/cocoa/cocoawinapi.inc @@ -102,6 +102,39 @@ begin NSObject(Handle).lclContentView.lclLocalToScreen(P.X, P.Y); end; +procedure TCocoaWidgetSet.CallDefaultWndHandler(Sender: TObject; var Message); +var + hnd : NSObject; + vw : NSView; + tb : Boolean; + ar : Boolean; + ks : Boolean; +const + WantTab : array [boolean] of integer = (0, DLGC_WANTTAB); + WantArrow : array [boolean] of integer = (0, DLGC_WANTARROWS); + WantKeys : array [boolean] of integer = (0, DLGC_WANTALLKEYS); +begin + case TLMessage(Message).Msg of + LM_GETDLGCODE: begin + hnd := nil; + if (Sender is TWinControl) then hnd := NSObject(TWinControl(Sender).Handle); + if not Assigned(hnd) then Exit; + vw := hnd.lclContentView(); + if Assigned(vw) then + begin + tb := false; + ar := false; + ks := false; + vw.lclExpectedKeys(tb, ar, ks); + TLMessage(Message).Result := TLMessage(Message).Result or WantTab[tb] or WantArrow[ar] or WantKeys[ks]; + end; + + end; + else + TLMessage(Message).Result := 0; + end; +end; + {------------------------------------------------------------------------------ Method: ClipboardFormatToMimeType Params: FormatID - A registered format identifier (0 is invalid) diff --git a/lcl/interfaces/cocoa/cocoawinapih.inc b/lcl/interfaces/cocoa/cocoawinapih.inc index 4204974216..7eb5942fbf 100644 --- a/lcl/interfaces/cocoa/cocoawinapih.inc +++ b/lcl/interfaces/cocoa/cocoawinapih.inc @@ -29,6 +29,7 @@ function BitBlt(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSr {function CallNextHookEx(hHk: HHOOK; ncode : Integer; wParam: WParam; lParam : LParam) : Integer; override; function CallWindowProc(lpPrevWndFunc : TFarProc; Handle : HWND; Msg : UINT; wParam: WParam; lParam : lParam) : Integer; override;} +procedure CallDefaultWndHandler(Sender: TObject; var Message); override; function ClientToScreen(Handle: HWND; var P: TPoint) : Boolean; override; function ClipboardFormatToMimeType(FormatID: TClipboardFormat): string; override; diff --git a/lcl/interfaces/cocoa/cocoawscommon.pas b/lcl/interfaces/cocoa/cocoawscommon.pas index f6239ebf3b..c5abd1d954 100644 --- a/lcl/interfaces/cocoa/cocoawscommon.pas +++ b/lcl/interfaces/cocoa/cocoawscommon.pas @@ -38,6 +38,12 @@ type function GetShouldBeEnabled: Boolean; protected FTarget: TWinControl; + _KeyMsg : TLMKey; + _CharMsg : TLMKey; + _SendChar : Boolean; + _IsSysKey : Boolean; + _IsKeyDown : Boolean; + _UTF8Character : TUTF8Char; class function CocoaModifiersToKeyState(AModifiers: NSUInteger): PtrInt; static; class function CocoaPressedMouseButtonsToKeyState(AMouseButtons: NSUInteger): PtrInt; static; procedure OffsetMousePos(var Point: NSPoint); @@ -46,6 +52,7 @@ type Owner: NSObject; Frame: NSObject; BlockCocoaUpDown: Boolean; + class constructor Create; constructor Create(AOwner: NSObject; ATarget: TWinControl); virtual; destructor Destroy; override; @@ -56,6 +63,15 @@ type function GetCaptureControlCallback: ICommonCallBack; function MouseUpDownEvent(Event: NSEvent; AForceAsMouseUp: Boolean = False; AOverrideBlock: Boolean = False): Boolean; virtual; function KeyEvent(Event: NSEvent; AForceAsKeyDown: Boolean = False): Boolean; virtual; + + procedure KeyEvBeforeDown(var AllowCocoaHandle: boolean); + procedure KeyEvAfterDown; + procedure KeyEvBeforeUp(var AllowCocoaHandle: boolean); + procedure KeyEvAfterUp; + procedure KeyEvPrepare(Event: NSEvent; AForceAsKeyDown: Boolean = False); + procedure KeyEvBefore(var AllowCocoaHandle: boolean); + procedure KeyEvAfter; + procedure MouseClick; virtual; function MouseMove(Event: NSEvent): Boolean; virtual; function scrollWheel(Event: NSEvent): Boolean; virtual; @@ -606,6 +622,7 @@ var // the LCL has handled the key Exit; end; + if OrigChar <> UTF8Character then LCLCharToMacEvent(UTF8Character); @@ -748,6 +765,329 @@ begin end; end; +procedure TLCLCommonCallback.KeyEvPrepare(Event: NSEvent; + AForceAsKeyDown: Boolean); +var + KeyCode: word; + UTF8VKCharacter: TUTF8Char; // char without modifiers, used for VK_ key value + UTF8Character: TUTF8Char; // char to send via IntfUtf8KeyPress + KeyChar : char; // Ascii char, when possible (xx_(SYS)CHAR) + VKKeyChar: char; // Ascii char without modifiers + SendChar: boolean; // Should we send char? + VKKeyCode: word; // VK_ code + IsSysKey: Boolean; // Is alt (option) key down? + KeyData: PtrInt; // Modifiers (ctrl, alt, mouse buttons...) +begin + SendChar := False; + VKKeyCode := VK_UNKNOWN; + + IsSysKey := (Event.modifierFlags and NSCommandKeyMask) <> 0; + KeyData := (Ord(Event.isARepeat) + 1) or Event.keyCode shl 16; + if (Event.modifierFlags and NSAlternateKeyMask) <> 0 then + KeyData := KeyData or $20000000; // So that MsgKeyDataToShiftState recognizes Alt key, see bug 30129 + KeyCode := Event.keyCode; + + //non-printable keys (see mackeycodes.inc) + //for these keys, only send keydown/keyup (not char or UTF8KeyPress) + case KeyCode of + MK_F1 : VKKeyCode:=VK_F1; + MK_F2 : VKKeyCode:=VK_F2; + MK_F3 : VKKeyCode:=VK_F3; + MK_F4 : VKKeyCode:=VK_F4; + MK_F5 : VKKeyCode:=VK_F5; + MK_F6 : VKKeyCode:=VK_F6; + MK_F7 : VKKeyCode:=VK_F7; + MK_F8 : VKKeyCode:=VK_F8; + MK_F9 : VKKeyCode:=VK_F9; + MK_F10 : VKKeyCode:=VK_F10; + MK_F11 : VKKeyCode:=VK_F11; + MK_F12 : VKKeyCode:=VK_F12; + MK_F13 : VKKeyCode:=VK_SNAPSHOT; + MK_F14 : VKKeyCode:=VK_SCROLL; + MK_F15 : VKKeyCode:=VK_PAUSE; + MK_POWER : VKKeyCode:=VK_SLEEP; //? + MK_TAB : VKKeyCode:=VK_TAB; //strangely enough, tab is "non printable" + MK_INS : VKKeyCode:=VK_INSERT; + MK_DEL : VKKeyCode:=VK_DELETE; + MK_HOME : VKKeyCode:=VK_HOME; + MK_END : VKKeyCode:=VK_END; + MK_PAGUP : VKKeyCode:=VK_PRIOR; + MK_PAGDN : VKKeyCode:=VK_NEXT; + MK_UP : VKKeyCode:=VK_UP; + MK_DOWN : VKKeyCode:=VK_DOWN; + MK_LEFT : VKKeyCode:= VK_LEFT; + MK_RIGHT : VKKeyCode:= VK_RIGHT; + MK_NUMLOCK : VKKeyCode:= VK_NUMLOCK; + end; + + if VKKeyCode = VK_UNKNOWN then + begin + // check non-translated characters + UTF8VKCharacter := NSStringToString(Event.charactersIgnoringModifiers); + if Length(UTF8VKCharacter) > 0 then + begin + if UTF8VKCharacter[1] <= #127 then + VKKeyChar := UTF8VKCharacter[1] + else + VKKeyChar := #0; + end; + + //printable keys + //for these keys, send char or UTF8KeyPress + UTF8Character := NSStringToString(Event.characters); + + if Length(UTF8Character) > 0 then + begin + SendChar := True; + + if Utf8Character[1] <= #127 then + KeyChar := Utf8Character[1] + else + KeyChar := #0; + + // the VKKeyCode is independent of the modifier + // => use the VKKeyChar instead of the KeyChar + case VKKeyChar of + 'a'..'z': VKKeyCode:=VK_A+ord(VKKeyChar)-ord('a'); + 'A'..'Z': VKKeyCode:=ord(VKKeyChar); + #27 : VKKeyCode:=VK_ESCAPE; + #8 : VKKeyCode:=VK_BACK; + ' ' : VKKeyCode:=VK_SPACE; + #13 : VKKeyCode:=VK_RETURN; + '0'..'9': + case KeyCode of + MK_NUMPAD0: VKKeyCode:=VK_NUMPAD0; + MK_NUMPAD1: VKKeyCode:=VK_NUMPAD1; + MK_NUMPAD2: VKKeyCode:=VK_NUMPAD2; + MK_NUMPAD3: VKKeyCode:=VK_NUMPAD3; + MK_NUMPAD4: VKKeyCode:=VK_NUMPAD4; + MK_NUMPAD5: VKKeyCode:=VK_NUMPAD5; + MK_NUMPAD6: VKKeyCode:=VK_NUMPAD6; + MK_NUMPAD7: VKKeyCode:=VK_NUMPAD7; + MK_NUMPAD8: VKKeyCode:=VK_NUMPAD8; + MK_NUMPAD9: VKKeyCode:=VK_NUMPAD9 + else VKKeyCode:=ord(VKKeyChar); + end; + else + case KeyCode of + MK_PADDIV : VKKeyCode:=VK_DIVIDE; + MK_PADMULT : VKKeyCode:=VK_MULTIPLY; + MK_PADSUB : VKKeyCode:=VK_SUBTRACT; + MK_PADADD : VKKeyCode:=VK_ADD; + MK_PADDEC : VKKeyCode:=VK_DECIMAL; + MK_BACKSPACE: + begin + VKKeyCode := VK_BACK; + VKKeyChar := #8; + UTF8Character := #8; + end; + MK_PADENTER: + begin + VKKeyCode:=VK_RETURN; + VKKeyChar:=#13; + UTF8Character:=VKKeyChar; + end; + MK_TILDE: VKKeyCode := VK_OEM_3; + MK_MINUS: VKKeyCode := VK_OEM_MINUS; + MK_EQUAL: VKKeyCode := VK_OEM_PLUS; + MK_BACKSLASH: VKKeyCode := VK_OEM_5; + MK_LEFTBRACKET: VKKeyCode := VK_OEM_4; + MK_RIGHTBRACKET: VKKeyCode := VK_OEM_6; + MK_SEMICOLON: VKKeyCode := VK_OEM_1; + MK_QUOTE: VKKeyCode := VK_OEM_7; + MK_COMMA: VKKeyCode := VK_OEM_COMMA; + MK_PERIOD: VKKeyCode := VK_OEM_PERIOD; + MK_SLASH: VKKeyCode := VK_OEM_2; + else + VKKeyCode := MacKeyToVK(KeyCode); // according to mackeycodes.inc this is risky + end; + end; + + if VKKeyCode = VK_UNKNOWN then + begin + // There is no known VK_ code for this characther. Use a dummy keycode + // (E8, which is unused by Windows) so that KeyUp/KeyDown events will be + // triggered by LCL. + // Note: we can't use the raw mac keycode, since it could collide with + // well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for + // "è" is 33, which is the same as VK_PRIOR) + VKKeyCode := $E8; + end; + //Result := True; + end; + end; + + FillChar(_KeyMsg, SizeOf(_KeyMsg), 0); + _KeyMsg.KeyData := KeyData; + _KeyMsg.CharCode := VKKeyCode; + _SendChar := SendChar; + _IsSysKey := IsSysKey; + _IsKeyDown := AForceAsKeyDown or (Event.type_ = NSKeyDown); + _UTF8Character := UTF8Character; + + FillChar(_CharMsg, SizeOf(_CharMsg), 0); + _CharMsg.KeyData := _KeyMsg.KeyData; + _CharMsg.CharCode := ord(KeyChar); +end; + +procedure TLCLCommonCallback.KeyEvBeforeDown(var AllowCocoaHandle: boolean); +var + OrigChar: AnsiString; +begin + // create the CN_KEYDOWN message + if _IsSysKey then + _KeyMsg.Msg := CN_SYSKEYDOWN + else + _KeyMsg.Msg := CN_KEYDOWN; + + // is the key combination help key (Cmd + ?) + if _SendChar and _IsSysKey and (_UTF8Character = '?') then + Application.ShowHelpForObject(Target); + + // widget can filter some keys from being send to cocoa control + //if Widget.FilterKeyPress(IsSysKey, UTF8Character) then Result := noErr; + + //Send message to LCL + if _KeyMsg.CharCode <> VK_UNKNOWN then + begin + if (DeliverMessage(_KeyMsg) <> 0) or (_KeyMsg.CharCode = VK_UNKNOWN) then + begin + // the LCL handled the key + AllowCocoaHandle := false; + NotifyApplicationUserInput(Target, _KeyMsg.Msg); + Exit; + end; + end; + + if (_SendChar) then begin + // assume "down" was succesfull and calling LM_KEYDOWN now + // otherwise, LM_KEYDOWN would be called in KeyEvAfter() + if _IsSysKey then + _KeyMsg.Msg := LM_SYSKEYDOWN + else + _KeyMsg.Msg := LM_KEYDOWN; + + if (DeliverMessage(_KeyMsg) <> 0) or (_KeyMsg.CharCode = VK_UNKNOWN) then + begin + AllowCocoaHandle := false; + NotifyApplicationUserInput(Target, _KeyMsg.Msg); + Exit; + end; + + + // send the UTF8 keypress + OrigChar := _UTF8Character; + if Target.IntfUTF8KeyPress(_UTF8Character, 1, _IsSysKey) then + begin + // the LCL has handled the key + Exit; + end; + + //if OrigChar <> _UTF8Character then + //LCLCharToMacEvent(_UTF8Character); + + // create the CN_CHAR / CN_SYSCHAR message + if _IsSysKey then + _CharMsg.Msg := CN_SYSCHAR + else + _CharMsg.Msg := CN_CHAR; + + //Send message to LCL + if (DeliverMessage(_CharMsg) <> 0) or (_CharMsg.CharCode=VK_UNKNOWN) then + begin + // the LCL handled the key + AllowCocoaHandle := false; + NotifyApplicationUserInput(Target, _CharMsg.Msg); + Exit; + end; + end; + +end; + +procedure TLCLCommonCallback.KeyEvBeforeUp(var AllowCocoaHandle: boolean); +begin + if _IsSysKey then + _KeyMsg.Msg := CN_SYSKEYUP + else + _KeyMsg.Msg := CN_KEYUP; + + //Send message to LCL + if _KeyMsg.CharCode <> VK_UNKNOWN then + begin + if (DeliverMessage(_KeyMsg) <> 0) or (_KeyMsg.CharCode = VK_UNKNOWN) then + begin + // the LCL has handled the key + AllowCocoaHandle := false; + NotifyApplicationUserInput(Target, _KeyMsg.Msg); + Exit; + end; + end; +end; + +procedure TLCLCommonCallback.KeyEvAfterDown; +begin + if _SendChar then begin + // LM_CHAR has not been set yet, send it now! + if _CharMsg.CharCode = 0 then Exit; + + //if _CharMsg.CharCode <> ord(_KeyChar) then + //LCLCharToMacEvent(Char(_CharMsg.CharCode)); + + //Send a LM_(SYS)CHAR + if _IsSysKey then + _CharMsg.Msg := LM_SYSCHAR + else + _CharMsg.Msg := LM_CHAR; + + if DeliverMessage(_CharMsg) <> 0 then + NotifyApplicationUserInput(Target, _CharMsg.Msg); + + end else begin + // LM_KeyDOWN has not been sent yet, send it now! + if (_KeyMsg.CharCode = VK_UNKNOWN) then Exit; + + if _IsSysKey then + _KeyMsg.Msg := LM_SYSKEYDOWN + else + _KeyMsg.Msg := LM_KEYDOWN; + + if (DeliverMessage(_KeyMsg) <> 0) or (_KeyMsg.CharCode = VK_UNKNOWN) then + begin + NotifyApplicationUserInput(Target, _KeyMsg.Msg); + Exit; + end; + end; +end; + +procedure TLCLCommonCallback.KeyEvAfterUp; +begin + //Send a LM_(SYS)KEYUP + if _IsSysKey then + _KeyMsg.Msg := LM_SYSKEYUP + else + _KeyMsg.Msg := LM_KEYUP; + + if DeliverMessage(_KeyMsg) <> 0 then + begin + // the LCL handled the key + NotifyApplicationUserInput(Target, _KeyMsg.Msg); + Exit; + end; +end; + +procedure TLCLCommonCallback.KeyEvBefore(var AllowCocoaHandle: boolean); +begin + AllowCocoaHandle := true; + if _IsKeyDown then KeyEvBeforeDown(AllowCocoaHandle) + else KeyEvBeforeUp(AllowCocoaHandle); +end; + +procedure TLCLCommonCallback.KeyEvAfter; +begin + if _IsKeyDown then KeyEvAfterDown + else KeyEvAfterUp; +end; + procedure TLCLCommonCallback.MouseClick; begin LCLSendClickedMsg(Target);