paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-29 14:11:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

Cocoa: Cursor: Improve support for Window/Application switching

Browse Source
This commit is contained in:
rich2014 2023-06-10 23:05:36 +08:00
parent da41c019a6
commit cdbab01c2d
2 changed files with 32 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/interfaces/cocoa/cocoawindows.pas
View File

@ -27,7 +27,7 @@ uses
Types, Classes, SysUtils, Types, Classes, SysUtils,
CGGeometry, CGGeometry,
// Libs // Libs
MacOSAll, CocoaAll, CocoaUtils, CocoaGDIObjects, MacOSAll, CocoaAll, CocoaUtils, CocoaWScommon,
cocoa_extra, CocoaPrivate, CocoaTextEdits, CocoaScrollers, cocoa_extra, CocoaPrivate, CocoaTextEdits, CocoaScrollers,
// LCL // LCL
//Forms, //Forms,
@ -776,6 +776,8 @@ begin
and Assigned(contentView) and Assigned(contentView)
and (contentView.isKindOfClass(TCocoaWindowContent)) then and (contentView.isKindOfClass(TCocoaWindowContent)) then
self.makeFirstResponder( TCocoaWindowContent(contentView).documentView ); self.makeFirstResponder( TCocoaWindowContent(contentView).documentView );
CursorHelper.SetCursorOnActive;
end; end;
procedure TCocoaWindow.windowDidResignKey(notification: NSNotification); procedure TCocoaWindow.windowDidResignKey(notification: NSNotification);

30
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -12,7 +12,7 @@ uses
CGGeometry, CocoaAll, cocoa_extra, CGGeometry, CocoaAll, cocoa_extra,
Classes, Controls, SysUtils, Classes, Controls, SysUtils,
// //
WSControls, LCLType, LMessages, LCLProc, Graphics, Forms, WSControls, LCLType, LMessages, LCLProc, LCLIntf, Graphics, Forms,
CocoaPrivate, CocoaGDIObjects, CocoaCaret, CocoaUtils, LCLMessageGlue, CocoaPrivate, CocoaGDIObjects, CocoaCaret, CocoaUtils, LCLMessageGlue,
CocoaScrollers; CocoaScrollers;
@ -20,7 +20,11 @@ type
{ TCursorHelper } { TCursorHelper }
TCursorHelper = class TCursorHelper = class
private
procedure CallSetCurrentControlCursor( data:IntPtr );
public public
class procedure SetCursorOnActive;
class procedure SetCurrentControlCursor;
class procedure SetScreenCursor; class procedure SetScreenCursor;
class procedure SetScreenCursorWhenNotDefault; class procedure SetScreenCursorWhenNotDefault;
end; end;
@ -356,6 +360,30 @@ end;
{ TCursorHelper } { TCursorHelper }
procedure TCursorHelper.CallSetCurrentControlCursor( data:IntPtr );
begin
SetCurrentControlCursor;
end;
class procedure TCursorHelper.SetCursorOnActive;
begin
if Screen.Cursor<>crDefault then
SetScreenCursor
else
Application.QueueAsyncCall( @CursorHelper.CallSetCurrentControlCursor, 0 );
end;
class procedure TCursorHelper.SetCurrentControlCursor;
var
P: TPoint;
control: TControl;
begin
GetCursorPos(P);
control:= FindControlAtPosition(P, true);;
if Assigned(control) then
TCocoaCursor(Screen.Cursors[control.Cursor]).SetCursor;
end;
class procedure TCursorHelper.SetScreenCursor; class procedure TCursorHelper.SetScreenCursor;
begin begin
TCocoaCursor(Screen.Cursors[Screen.Cursor]).SetCursor; TCocoaCursor(Screen.Cursors[Screen.Cursor]).SetCursor;