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

Merge branch 'lcl/cocoa/cursor'

Browse Source
This commit is contained in:
rich2014 2023-06-10 23:07:08 +08:00
commit 78bdae581b
10 changed files with 86 additions and 167 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/interfaces/cocoa/cocoabuttons.pas
View File

@ -89,7 +89,6 @@ type
procedure mouseEntered(event: NSEvent); override;
procedure mouseExited(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure resetCursorRects; override;
// lcl overrides
procedure lclSetFrame(const r: TRect); override;
procedure lclCheckMixedAllowance; message 'lclCheckMixedAllowance';
@ -420,12 +419,6 @@ begin
inherited otherMouseUp(event);
end;
procedure TCocoaButton.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaButton.mouseDown(event: NSEvent);
begin
if not Assigned(callback) or not callback.MouseUpDownEvent(event) then

18
lcl/interfaces/cocoa/cocoagdiobjects.pas
View File

@ -311,9 +311,7 @@ type
constructor CreateFromBitmap(const ABitmap: TCocoaBitmap; const hotSpot: NSPoint);
constructor CreateFromCustomCursor(const ACursor: NSCursor);
destructor Destroy; override;
function Install: TCocoaCursor;
procedure SetCursor;
class procedure SetDefaultCursor;
property Cursor: NSCursor read FCursor;
property Standard: Boolean read FStandard;
end;
@ -1233,25 +1231,11 @@ begin
inherited;
end;
function TCocoaCursor.Install: TCocoaCursor;
begin
FCursor.push;
// also request form cursors invalidation
CocoaWidgetSet.NSApp.keyWindow.resetCursorRects;
Result := nil;
end;
procedure TCocoaCursor.SetCursor;
begin
FCursor.set_;
FCursor.set_;
end;
class procedure TCocoaCursor.SetDefaultCursor;
begin
NSCursor.arrowCursor.set_;
end;
{ TCocoaContext }
function TCocoaContext.CGContext: CGContextRef;

1
lcl/interfaces/cocoa/cocoaint.pas
View File

@ -232,7 +232,6 @@ type
function GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer;
class function Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
property NSApp: TCocoaApplication read FNSApp;
property CurrentCursor: HCursor read FCurrentCursor write FCurrentCursor;
property CaptureControl: HWND read FCaptureControl;
// the winapi compatibility methods
{$I cocoawinapih.inc}

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

@ -89,7 +89,6 @@ type
procedure Draw(ctx: NSGraphicsContext; const bounds, dirty: NSRect);
procedure DrawBackground(ctx: NSGraphicsContext; const bounds, dirty: NSRect);
procedure DrawOverlay(ctx: NSGraphicsContext; const bounds, dirty: NSRect);
function ResetCursorRects: Boolean;
procedure BecomeFirstResponder;
procedure ResignFirstResponder;
procedure DidBecomeKeyNotification;
@ -230,8 +229,6 @@ type
procedure scrollWheel(event: NSEvent); override;
// nsview
procedure setFrame(aframe: NSRect); override;
// other
procedure resetCursorRects; override;
// value
procedure setStringValue(avalue: NSString); override;
function stringValue: NSString; override;
@ -341,7 +338,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
function lclClientFrame: TRect; override;
function lclContentView: NSView; override;
function lclGetFrameToLayoutDelta: TRect; override;
@ -360,7 +356,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
function lclGetFrameToLayoutDelta: TRect; override;
procedure lclSetFrame(const r: TRect); override;
// mouse
@ -401,7 +396,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
//
procedure SnapToInteger(AExtraFactor: Integer = 0); message 'SnapToInteger:';
procedure sliderAction(sender: id); message 'sliderAction:';
@ -589,12 +583,6 @@ begin
callback := nil;
end;
procedure TCocoaGroupBox.resetCursorRects;
begin
if not Assigned(callback) or not callback.resetCursorRects then
inherited resetCursorRects;
end;
{ TCocoaCustomControl }
procedure TCocoaCustomControl.setStringValue(avalue: NSString);
@ -852,12 +840,6 @@ begin
inherited otherMouseDragged(event);
end;
procedure TCocoaCustomControl.resetCursorRects;
begin
if not Assigned(callback) or not callback.resetCursorRects then
inherited resetCursorRects;
end;
{ TCocoaIMEParameters }
@ -1626,12 +1608,6 @@ begin
callback:=nil;
end;
procedure TCocoaProgressIndicator.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
function TCocoaProgressIndicator.lclGetFrameToLayoutDelta: TRect;
begin
case controlSize of
@ -1797,12 +1773,6 @@ begin
callback := nil;
end;
procedure TCocoaSlider.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaSlider.SnapToInteger(AExtraFactor: Integer);
begin
setIntValue(Round(doubleValue() + AExtraFactor));

16
lcl/interfaces/cocoa/cocoascrollers.pas
View File

@ -46,7 +46,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
function lclClientFrame: TRect; override;
function lclContentView: NSView; override;
procedure setDocumentView(aView: NSView); override;
@ -113,7 +112,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
function lclPos: Integer; message 'lclPos';
procedure lclSetPos(aPos: integer); message 'lclSetPos:';
// mouse
@ -807,12 +805,6 @@ begin
callback := nil;
end;
procedure TCocoaScrollView.resetCursorRects;
begin
if not Assigned(callback) or not callback.resetCursorRects then
inherited resetCursorRects;
end;
{ TCocoaScrollBar }
procedure TCocoaScrollBar.actionScrolling(sender: NSObject);
@ -993,13 +985,5 @@ begin
callback := nil;
end;
procedure TCocoaScrollBar.resetCursorRects;
begin
if not Assigned(callback) or not callback.resetCursorRects then
inherited resetCursorRects;
end;
end.

7
lcl/interfaces/cocoa/cocoatables.pas
View File

@ -94,7 +94,6 @@ type
function initWithFrame(frameRect: NSRect): id; override;
procedure dealloc; override;
procedure resetCursorRects; override;
procedure drawRow_clipRect(row: NSInteger; clipRect: NSRect); override;
procedure drawRect(dirtyRect: NSRect); override;
@ -506,12 +505,6 @@ begin
inherited dealloc;
end;
procedure TCocoaTableListView.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaTableListView.drawRow_clipRect(row: NSInteger; clipRect: NSRect
);
var

48
lcl/interfaces/cocoa/cocoatextedits.pas
View File

@ -68,7 +68,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
// key
procedure textDidChange(notification: NSNotification); override;
function textView_shouldChangeTextInRange_replacementString (textView: NSTextView; affectedCharRange: NSRange; replacementString: NSString): ObjCBOOL; message 'textView:shouldChangeTextInRange:replacementString:';
@ -93,7 +92,6 @@ type
maxLength: Integer;
callback: ICommonCallback;
function acceptsFirstResponder: LCLObjCBoolean; override;
procedure resetCursorRects; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
// key
@ -128,7 +126,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
procedure changeColor(sender: id); override;
// keyboard
@ -271,7 +268,6 @@ type
procedure dealloc; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
// NSComboBoxDelegateProtocol
procedure comboBoxWillPopUp(notification: NSNotification); message 'comboBoxWillPopUp:';
procedure comboBoxWillDismiss(notification: NSNotification); message 'comboBoxWillDismiss:';
@ -338,7 +334,6 @@ type
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
function lclGetFrameToLayoutDelta: TRect; override;
procedure resetCursorRects; override;
procedure comboboxAction(sender: id); message 'comboboxAction:';
function stringValue: NSString; override;
// drawing
@ -421,7 +416,6 @@ type
function acceptsFirstResponder: LCLObjCBoolean; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
procedure lclSetVisible(AVisible: Boolean); override;
procedure lclSetFrame(const r: TRect); override;
// NSViewFix
@ -969,15 +963,6 @@ begin
callback := nil;
end;
procedure TCocoaTextField.resetCursorRects;
begin
// this will not work well because
// cocoa replaced TextField and TextView cursors in
// mouseEntered, mouseMoved and CursorUpdate
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaTextField.textDidChange(notification: NSNotification);
begin
if (maxLength>0) and Assigned(stringValue) and (stringValue.length > maxLength) then
@ -1100,12 +1085,6 @@ begin
callback := nil;
end;
procedure TCocoaTextView.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaTextView.doCommandBySelector(aSelector: SEL);
begin
inherited doCommandBySelector(aSelector);
@ -1242,12 +1221,6 @@ begin
Result := NSViewCanFocus(Self);
end;
procedure TCocoaSecureTextField.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
function TCocoaSecureTextField.lclGetCallback: ICommonCallback;
begin
Result := callback;
@ -1466,12 +1439,6 @@ begin
callback := nil;
end;
procedure TCocoaComboBox.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaComboBox.comboBoxWillPopUp(notification: NSNotification);
begin
callback.ComboBoxWillPopUp;
@ -1636,12 +1603,6 @@ begin
end;
end;
procedure TCocoaReadOnlyComboBox.resetCursorRects;
begin
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaReadOnlyComboBox.comboboxAction(sender: id);
begin
//setTitle(NSSTR(PChar(Format('%d=%d', [indexOfSelectedItem, lastSelectedItemIndex])))); // <= for debugging
@ -2160,15 +2121,6 @@ begin
callback := nil;
end;
procedure TCocoaSpinEdit.resetCursorRects;
begin
// this will not work well because
// cocoa replaced TextField and TextView cursors in
// mouseEntered, mouseMoved and CursorUpdate
if not callback.resetCursorRects then
inherited resetCursorRects;
end;
procedure TCocoaSpinEdit.lclSetVisible(AVisible: Boolean);
begin
inherited lclSetVisible(AVisible);

5
lcl/interfaces/cocoa/cocoawinapi.inc
View File

@ -2519,8 +2519,9 @@ end;
function TCocoaWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
begin
if ACursor = 0 then Result := 0 else
Result := HCURSOR(TCocoaCursor(ACursor).Install);
if ACursor = 0 then ACursor:= Screen.Cursors[crDefault];
TCocoaCursor(ACursor).SetCursor;
Result := 0;
end;
function TCocoaWidgetSet.SetCursorPos(X, Y: Integer): Boolean;

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

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

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

@ -12,11 +12,23 @@ uses
CGGeometry, CocoaAll, cocoa_extra,
Classes, Controls, SysUtils,
//
WSControls, LCLType, LMessages, LCLProc, Graphics, Forms,
WSControls, LCLType, LMessages, LCLProc, LCLIntf, Graphics, Forms,
CocoaPrivate, CocoaGDIObjects, CocoaCaret, CocoaUtils, LCLMessageGlue,
CocoaScrollers;
type
{ TCursorHelper }
TCursorHelper = class
private
procedure CallSetCurrentControlCursor( data:IntPtr );
public
class procedure SetCursorOnActive;
class procedure SetCurrentControlCursor;
class procedure SetScreenCursor;
class procedure SetScreenCursorWhenNotDefault;
end;
{ TLCLCommonCallback }
TLCLCommonCallback = class(TObject, ICommonCallBack)
@ -107,7 +119,6 @@ type
procedure Draw(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); virtual;
procedure DrawBackground(ctx: NSGraphicsContext; const bounds, dirtyRect: NSRect); virtual;
procedure DrawOverlay(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); virtual;
function ResetCursorRects: Boolean; virtual;
procedure RemoveTarget; virtual;
procedure InputClientInsertText(const utf8: string);
@ -191,6 +202,9 @@ function NSObjectDebugStr(obj: NSObject): string;
function CallbackDebugStr(cb: ICommonCallback): string;
procedure DebugDumpParents(fromView: NSView);
var
CursorHelper: TCursorHelper;
implementation
uses
@ -343,6 +357,44 @@ begin
SetViewDefaults(Result);
end;
{ 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;
begin
TCocoaCursor(Screen.Cursors[Screen.Cursor]).SetCursor;
end;
class procedure TCursorHelper.SetScreenCursorWhenNotDefault;
begin
if Screen.Cursor<>crDefault then
SetScreenCursor;
end;
{ TLCLCommonCallback }
function TLCLCommonCallback.GetHasCaret: Boolean;
@ -1204,6 +1256,10 @@ begin
NotifyApplicationUserInput(Target, Msg.Msg);
Result := DeliverMessage(Msg) <> 0;
if BlockCocoaMouseMove then Result := true;
// if Screen.Cursor set, LCL won't call TCocoaWSWinControl.SetCursor().
// we need to set the cursor ourselves
CursorHelper.SetScreenCursorWhenNotDefault;
end;
function TLCLCommonCallback.scrollWheel(Event: NSEvent): Boolean;
@ -1523,34 +1579,6 @@ begin
end;
end;
function TLCLCommonCallback.ResetCursorRects: Boolean;
var
ACursor: TCursor;
View: NSView;
cr:TCocoaCursor;
begin
Result := False;
View := HandleFrame.lclContentView;
if View = nil then Exit;
if not Assigned(Target) then Exit;
if not (csDesigning in Target.ComponentState) then
begin
ACursor := Screen.RealCursor;
if ACursor = crDefault then
begin
// traverse visible child controls
ACursor := Target.Cursor;
end;
Result := ACursor <> crDefault;
if Result then
begin
cr:=TCocoaCursor(Screen.Cursors[ACursor]);
if assigned(cr) then
View.addCursorRect_cursor(View.visibleRect, cr.Cursor);
end;
end;
end;
procedure TLCLCommonCallback.RemoveTarget;
begin
FTarget := nil;
@ -1798,17 +1826,24 @@ end;
class procedure TCocoaWSWinControl.SetCursor(const AWinControl: TWinControl;
const ACursor: HCursor);
var
control: TControl;
begin
//debugln('SetCursor '+AWinControl.name+' '+dbgs(ACursor));
if CocoaWidgetSet.CurrentCursor<>ACursor then
begin
CocoaWidgetSet.CurrentCursor:= ACursor;
if ACursor<>0 then
TCocoaCursor(ACursor).SetCursor
else
TCocoaCursor.SetDefaultCursor;
end;
// screen cursor has higher priority than control cursor.
if Screen.Cursor<>crDefault
then exit;
// control cursor only need be set when mouse in AWinControl.
// suppose there is a Button, which is to set a Cursor of a ListBox.
// without the code here, it will be set to the Cursor of the ListBox
// after clicking the Button.
control:= Application.GetControlAtMouse;
if control<>AWinControl then
exit;
TCocoaCursor(ACursor).SetCursor;
end;
type
@ -2078,5 +2113,11 @@ begin
end;
end;
initialization
CursorHelper:= TCursorHelper.Create;
finalization
FreeAndNil(CursorHelper);
end.