diff --git a/.gitattributes b/.gitattributes index d2ce0c3458..29c534ae4b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8836,6 +8836,7 @@ lcl/interfaces/cocoa/cocoatrayicon.inc svneol=native#text/pascal lcl/interfaces/cocoa/cocoautils.pas svneol=native#text/plain lcl/interfaces/cocoa/cocoawinapi.inc svneol=native#text/pascal lcl/interfaces/cocoa/cocoawinapih.inc svneol=native#text/pascal +lcl/interfaces/cocoa/cocoawindows.pas svneol=native#text/plain lcl/interfaces/cocoa/cocoawsbuttons.pp svneol=native#text/pascal lcl/interfaces/cocoa/cocoawschecklst.pas svneol=native#text/plain lcl/interfaces/cocoa/cocoawscomctrls.pas svneol=native#text/plain diff --git a/lcl/interfaces/cocoa/cocoaint.pas b/lcl/interfaces/cocoa/cocoaint.pas index f70985bf6e..23a9aa7400 100644 --- a/lcl/interfaces/cocoa/cocoaint.pas +++ b/lcl/interfaces/cocoa/cocoaint.pas @@ -36,7 +36,7 @@ uses LCLPlatformDef, InterfaceBase, GraphType, // private CocoaAll, CocoaPrivate, CocoaUtils, CocoaGDIObjects, - cocoa_extra, CocoaWSMenus, CocoaWSForms, + cocoa_extra, CocoaWSMenus, CocoaWSForms, CocoaWindows, // LCL LCLStrConsts, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType, Controls, Forms, Themes, Menus, diff --git a/lcl/interfaces/cocoa/cocoaprivate.pp b/lcl/interfaces/cocoa/cocoaprivate.pp index 31ad25d3b1..88682736d3 100644 --- a/lcl/interfaces/cocoa/cocoaprivate.pp +++ b/lcl/interfaces/cocoa/cocoaprivate.pp @@ -150,28 +150,6 @@ type procedure lclSetEnabled(AEnabled: Boolean); message 'lclSetEnabled:'; reintroduce; end; - { LCLWindowExtension } - - LCLWindowExtension = objccategory(NSWindow) - function lclIsVisible: Boolean; message 'lclIsVisible'; reintroduce; - procedure lclSetVisible(AVisible: Boolean); message 'lclSetVisible:'; reintroduce; - function lclIsEnabled: Boolean; message 'lclIsEnabled'; reintroduce; - procedure lclSetEnabled(AEnabled: Boolean); message 'lclSetEnabled:'; reintroduce; - - function lclWindowState: Integer; message 'lclWindowState'; reintroduce; - procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce; - procedure lclInvalidate; message 'lclInvalidate'; reintroduce; - procedure lclUpdate; message 'lclUpdate'; reintroduce; - procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce; - procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce; - procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce; - function lclFrame: TRect; message 'lclFrame'; reintroduce; - procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce; - function lclClientFrame: TRect; message 'lclClientFrame'; reintroduce; - function lclGetTopBarHeight:integer; message 'lclGetTopBarHeight'; reintroduce; - procedure lclOffsetMousePos(var Point: NSPoint); message 'lclOffsetMousePos:'; reintroduce; - end; - { IListBoxCallBack } IListBoxCallBack = interface(ICommonCallback) @@ -300,41 +278,6 @@ type procedure textDidChange(notification: NSNotification); message 'textDidChange:'; end; - { TCocoaPanel } - - TCocoaPanel = objcclass(NSPanel, NSWindowDelegateProtocol) - protected - function windowShouldClose(sender : id): LongBool; message 'windowShouldClose:'; - procedure windowWillClose(notification: NSNotification); message 'windowWillClose:'; - procedure windowDidBecomeKey(notification: NSNotification); message 'windowDidBecomeKey:'; - procedure windowDidResignKey(notification: NSNotification); message 'windowDidResignKey:'; - procedure windowDidResize(notification: NSNotification); message 'windowDidResize:'; - procedure windowDidMove(notification: NSNotification); message 'windowDidMove:'; - public - callback: IWindowCallback; - function acceptsFirstResponder: Boolean; override; - function canBecomeKeyWindow: Boolean; override; - function becomeFirstResponder: Boolean; override; - function resignFirstResponder: Boolean; override; - function lclGetCallback: ICommonCallback; override; - procedure lclClearCallback; override; - // mouse - procedure mouseDown(event: NSEvent); override; - procedure mouseUp(event: NSEvent); override; - procedure rightMouseDown(event: NSEvent); override; - procedure rightMouseUp(event: NSEvent); override; - procedure rightMouseDragged(event: NSEvent); override; - procedure otherMouseDown(event: NSEvent); override; - procedure otherMouseUp(event: NSEvent); override; - procedure otherMouseDragged(event: NSEvent); override; - procedure mouseDragged(event: NSEvent); override; - procedure mouseEntered(event: NSEvent); override; - procedure mouseExited(event: NSEvent); override; - procedure mouseMoved(event: NSEvent); override; - procedure sendEvent(event: NSEvent); override; - function lclIsHandle: Boolean; override; - end; - { TCocoaFieldEditor } TCocoaFieldEditor = objcclass(NSTextView) @@ -354,74 +297,6 @@ type procedure mouseMoved(event: NSEvent); override; end; - { TCocoaWindow } - - TCocoaWindowContent = objcclass; - - TCocoaWindow = objcclass(NSWindow, NSWindowDelegateProtocol) - protected - fieldEditor: TCocoaFieldEditor; - firedMouseEvent: Boolean; - isInFullScreen: Boolean; - fsview: TCocoaWindowContent; - function windowShouldClose(sender : id): LongBool; message 'windowShouldClose:'; - function windowWillReturnFieldEditor_toObject(sender: NSWindow; client: id): id; message 'windowWillReturnFieldEditor:toObject:'; - procedure windowWillClose(notification: NSNotification); message 'windowWillClose:'; - procedure windowDidBecomeKey(notification: NSNotification); message 'windowDidBecomeKey:'; - procedure windowDidResignKey(notification: NSNotification); message 'windowDidResignKey:'; - procedure windowDidResize(notification: NSNotification); message 'windowDidResize:'; - procedure windowDidMove(notification: NSNotification); message 'windowDidMove:'; - // fullscreen notifications are only reported for 10.7 fullscreen - procedure windowWillEnterFullScreen(notification: NSNotification); message 'windowWillEnterFullScreen:'; - procedure windowDidEnterFullScreen(notification: NSNotification); message 'windowDidEnterFullScreen:'; - procedure windowDidExitFullScreen(notification: NSNotification); message 'windowDidExitFullScreen:'; - public - callback: IWindowCallback; - LCLForm: TCustomForm; - procedure dealloc; override; - function acceptsFirstResponder: Boolean; override; - function canBecomeKeyWindow: Boolean; override; - function becomeFirstResponder: Boolean; override; - function resignFirstResponder: Boolean; override; - function lclGetCallback: ICommonCallback; override; - procedure lclClearCallback; override; - // mouse - procedure mouseDown(event: NSEvent); override; - procedure mouseUp(event: NSEvent); override; - procedure rightMouseDown(event: NSEvent); override; - procedure rightMouseUp(event: NSEvent); override; - procedure rightMouseDragged(event: NSEvent); override; - procedure otherMouseDown(event: NSEvent); override; - procedure otherMouseUp(event: NSEvent); override; - procedure otherMouseDragged(event: NSEvent); override; - procedure mouseDragged(event: NSEvent); override; - procedure mouseEntered(event: NSEvent); override; - procedure mouseExited(event: NSEvent); override; - procedure mouseMoved(event: NSEvent); override; - procedure scrollWheel(event: NSEvent); override; - procedure sendEvent(event: NSEvent); override; - function lclIsHandle: Boolean; override; - // NSDraggingDestinationCategory - function draggingEntered(sender: NSDraggingInfoProtocol): NSDragOperation; override; - function performDragOperation(sender: NSDraggingInfoProtocol): Boolean; override; - // menu support - procedure lclItemSelected(sender: id); message 'lclItemSelected:'; - - procedure lclSwitchFullScreen(AEnabled: Boolean); message 'lclSwitchFullScreen:'; - function lclIsFullScreen: Boolean; message 'lclIsFullScreen'; - end; - - { TCocoaDesignOverlay } - - TCocoaDesignOverlay = objcclass(NSView) - callback : ICommonCallback; - procedure drawRect(r: NSRect); override; - function acceptsFirstResponder: Boolean; override; - function hitTest(aPoint: NSPoint): NSView; override; - function lclGetCallback: ICommonCallback; override; - procedure lclClearCallback; override; - end; - { TCocoaCustomControl } TCocoaCustomControl = objcclass(NSControl) @@ -468,32 +343,6 @@ type function stringValue: NSString; override; end; - { TCocoaWindowContent } - - TCocoaWindowContent = objcclass(TCocoaCustomControl) - protected - procedure didBecomeKeyNotification(sender: NSNotification); message 'didBecomeKeyNotification:'; - procedure didResignKeyNotification(sender: NSNotification); message 'didResignKeyNotification:'; - public - isembedded: Boolean; // true - if the content is inside of another control, false - if the content is in its own window; - ownwin: NSWindow; - fswin: NSWindow; // window that was used as a content prior to switching to old-school fullscreen - popup_parent: HWND; // if not 0, indicates that we should set the popup parent - overlay: NSView; - function performKeyEquivalent(event: NSEvent): Boolean; override; - procedure resolvePopupParent(); message 'resolvePopupParent'; - function lclOwnWindow: NSWindow; message 'lclOwnWindow'; - procedure lclSetFrame(const r: TRect); override; - function lclFrame: TRect; override; - procedure viewDidMoveToSuperview; override; - procedure viewDidMoveToWindow; override; - procedure viewWillMoveToWindow(newWindow: CocoaAll.NSWindow); override; - procedure dealloc; override; - procedure setHidden(aisHidden: Boolean); override; - function lclIsHandle: Boolean; override; - procedure didAddSubview(aview: NSView); override; - end; - { TCocoaScrollView } TCocoaScrollView = objcclass(NSScrollView) @@ -997,35 +846,6 @@ begin {$ENDIF} end; -{ TCocoaDesignOverlay } - -procedure TCocoaDesignOverlay.drawRect(r: NSRect); -begin - if Assigned(callback) then - callback.DrawOverlay(NSGraphicsContext.currentContext, bounds, r); - inherited drawRect(r); -end; - -function TCocoaDesignOverlay.acceptsFirstResponder: Boolean; -begin - Result:=false; // no focus -end; - -function TCocoaDesignOverlay.hitTest(aPoint: NSPoint): NSView; -begin - Result:=nil; // no mouse -end; - -function TCocoaDesignOverlay.lclGetCallback: ICommonCallback; -begin - Result := callback; -end; - -procedure TCocoaDesignOverlay.lclClearCallback; -begin - callback := nil; -end; - { TCocoaManualScrollView } function TCocoaManualScrollView.lclGetCallback: ICommonCallback; @@ -1259,344 +1079,6 @@ begin end; end; -{ TCocoaWindowContent } - -function TCocoaWindowContent.lclIsHandle: Boolean; -begin - Result:=true; -end; - -procedure TCocoaWindowContent.didAddSubview(aview: NSView); -begin - if Assigned(aview) and Assigned(overlay) and (overlay<>aview) then - begin - overlay.retain; - overlay.removeFromSuperview; - addSubview_positioned_relativeTo(overlay, NSWindowAbove, nil); - end; - inherited didAddSubview(aview); -end; - -procedure TCocoaWindowContent.didBecomeKeyNotification(sender: NSNotification); -begin - if Assigned(callback) then - callback.DidBecomeKeyNotification; -end; - -procedure TCocoaWindowContent.didResignKeyNotification(sender: NSNotification); -begin - if Assigned(callback) then - callback.DidResignKeyNotification; -end; - -function TCocoaWindowContent.performKeyEquivalent(event: NSEvent): Boolean; -begin - // this event servers all TextEdit, ComboBoxes and Memos on a form. - // to do short keys for copy, paste, cut, etc... - Result := false; - NSResponderHotKeys(self, event, Result); - if not Result then - Result:=inherited performKeyEquivalent(event); -end; - -procedure TCocoaWindowContent.resolvePopupParent(); -var - lWindow: NSWindow; -begin - lWindow := nil; - if (popup_parent <> 0) then - begin - if (NSObject(popup_parent).isKindOfClass(TCocoaWindowContent)) then - begin - if (not TCocoaWindowContent(popup_parent).isembedded) then - lWindow := NSWindow(TCocoaWindowContent(popup_parent).window); - end - else - begin - lWindow := NSWindow(popup_parent); - end; - end; - if lWindow <> nil then - lWindow.addChildWindow_ordered(Self.window, NSWindowAbove); - popup_parent := 0; -end; - -function TCocoaWindowContent.lclOwnWindow: NSWindow; -begin - if not isembedded then - Result := NSWindow(window) - else - Result := nil; -end; - -procedure TCocoaWindowContent.lclSetFrame(const r: TRect); -begin - if isembedded then - inherited lclSetFrame(r) - else - window.lclSetFrame(r); -end; - -function TCocoaWindowContent.lclFrame: TRect; -var - wfrm : TRect; -begin - Result := inherited lclFrame; - if not isembedded then - begin - //Window bounds should return "client rect" in screen coordinates - if Assigned(window.screen) then - NSToLCLRect(window.frame, window.screen.frame.size.height, wfrm) - else - wfrm := NSRectToRect(frame); - OffsetRect(Result, -Result.Left+wfrm.Left, -Result.Top+wfrm.Top); - end; -end; - -procedure TCocoaWindowContent.viewDidMoveToSuperview; -begin - inherited viewDidMoveToSuperview; -end; - -procedure TCocoaWindowContent.viewDidMoveToWindow; -begin - isembedded := window.contentView <> self; - if isembedded then - begin - if Assigned(ownwin) then - ownwin.close; - ownwin := nil; - end - else - begin - ownwin := NSWindow(window); - end; - inherited viewDidMoveToWindow; -end; - -procedure TCocoaWindowContent.viewWillMoveToWindow(newWindow: CocoaAll.NSWindow); -begin - if newWindow<>nil then - newWindow.setAcceptsMouseMovedEvents(True); - if not isembedded and (newWindow <> window) then - begin - if Assigned(window) then - window.close; - ownwin := nil; - isembedded := false; - end; - inherited viewWillMoveToWindow(newWindow); -end; - -procedure TCocoaWindowContent.dealloc; -begin - inherited dealloc; -end; - -procedure TCocoaWindowContent.setHidden(aisHidden: Boolean); -begin - if isembedded then - begin - inherited setHidden(aisHidden); - end - else - begin - if aisHidden and window.isVisible then - window.orderOut(nil) - else - if not aisHidden and not window.isVisible then - window.orderBack(nil); - end; -end; - -{ TCocoaPanel } - -function TCocoaPanel.lclIsHandle: Boolean; -begin - Result:=true; -end; - -function TCocoaPanel.windowShouldClose(sender: id): LongBool; -var - canClose: Boolean; -begin - canClose := True; - if Assigned(callback) then - callback.CloseQuery(canClose); - Result := canClose; -end; - -procedure TCocoaPanel.windowWillClose(notification: NSNotification); -begin - if Assigned(callback) then - callback.Close; -end; - -procedure TCocoaPanel.windowDidBecomeKey(notification: NSNotification); -begin - if Assigned(callback) then - callback.Activate; -end; - -procedure TCocoaPanel.windowDidResignKey(notification: NSNotification); -begin - if Assigned(callback) then - callback.Deactivate; -end; - -procedure TCocoaPanel.windowDidResize(notification: NSNotification); -begin - if Assigned(callback) then - callback.Resize; -end; - -procedure TCocoaPanel.windowDidMove(notification: NSNotification); -begin - if Assigned(callback) then - callback.Move; -end; - -function TCocoaPanel.acceptsFirstResponder: Boolean; -begin - Result := True; -end; - -function TCocoaPanel.canBecomeKeyWindow: Boolean; -begin - Result := Assigned(callback) and callback.CanActivate; -end; - -function TCocoaPanel.becomeFirstResponder: Boolean; -begin - Result := inherited becomeFirstResponder; -// if Assigned(callback) then -// callback.BecomeFirstResponder; -end; - -function TCocoaPanel.resignFirstResponder: Boolean; -begin - Result := inherited resignFirstResponder; -// if Assigned(callback) then -// callback.ResignFirstResponder; -end; - -function TCocoaPanel.lclGetCallback: ICommonCallback; -begin - Result := callback; -end; - -procedure TCocoaPanel.lclClearCallback; -begin - callback := nil; - contentView.lclClearCallback; -end; - -procedure TCocoaPanel.mouseDown(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited mouseDown(event); -end; - -procedure TCocoaPanel.mouseUp(event: NSEvent); -begin - if Assigned(callback) then callback.MouseUpDownEvent(event); - inherited mouseUp(event); -end; - -procedure TCocoaPanel.rightMouseDown(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseUp(event); -end; - -procedure TCocoaPanel.rightMouseUp(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseDown(event); -end; - -procedure TCocoaPanel.rightMouseDragged(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseDragged(event); -end; - -procedure TCocoaPanel.otherMouseDown(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseDown(event); -end; - -procedure TCocoaPanel.otherMouseUp(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseUp(event); -end; - -procedure TCocoaPanel.otherMouseDragged(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseDown(event); -end; - -procedure TCocoaPanel.mouseDragged(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseMove(event) then - inherited mouseDragged(event); -end; - -procedure TCocoaPanel.mouseEntered(event: NSEvent); -begin - inherited mouseEntered(event); -end; - -procedure TCocoaPanel.mouseExited(event: NSEvent); -begin - inherited mouseExited(event); -end; - -procedure TCocoaPanel.mouseMoved(event: NSEvent); -begin - if not Assigned(callback) or not callback.MouseMove(event) then - inherited mouseMoved(event); -end; - -procedure TCocoaPanel.sendEvent(event: NSEvent); -var - Message: NSMutableDictionary; - Handle: HWND; - Msg: Cardinal; - WP: WParam; - LP: LParam; - ResultCode: NSNumber; - Obj: NSObject; -begin - if event.type_ = NSApplicationDefined then - begin - // event which we get through PostMessage or SendMessage - if event.subtype = LCLEventSubTypeMessage then - begin - // extract message data - Message := NSMutableDictionary(event.data1); - Handle := NSNumber(Message.objectForKey(NSMessageWnd)).unsignedIntegerValue; - Msg := NSNumber(Message.objectForKey(NSMessageMsg)).unsignedLongValue; - WP := NSNumber(Message.objectForKey(NSMessageWParam)).integerValue; - LP := NSNumber(Message.objectForKey(NSMessageLParam)).integerValue; - Obj := NSObject(Handle); - // deliver message and set result if response requested - // todo: check that Obj is still a valid NSView/NSWindow - ResultCode := NSNumber.numberWithInteger(Obj.lclDeliverMessage(Msg, WP, LP)); - if event.data2 <> 0 then - Message.setObject_forKey(ResultCode, NSMessageResult) - else - Message.release; - //ResultCode.release; // will be auto-released - end; - end - else - inherited sendEvent(event); -end; - { TCocoaFieldEditor } function TCocoaFieldEditor.resignFirstResponder: Boolean; @@ -1728,378 +1210,6 @@ begin inherited mouseMoved(event); end; -{ TCocoaWindow } - -function TCocoaWindow.lclIsHandle: Boolean; -begin - Result:=true; -end; - -function TCocoaWindow.windowShouldClose(sender: id): LongBool; -var - canClose: Boolean; -begin - canClose := True; - if Assigned(callback) then - callback.CloseQuery(canClose); - Result := canClose; -end; - -function TCocoaWindow.windowWillReturnFieldEditor_toObject(sender: NSWindow; - client: id): id; -begin - //DebugLn('[TCocoaWindow.windowWillReturnFieldEditor_toObject]'); - Result := nil; - if (fieldEditor = nil) then - begin - fieldEditor := TCocoaFieldEditor.alloc.init; - fieldEditor.setFieldEditor(True); - end; - if client.isKindOfClass_(TCocoaTextField) or - client.isKindOfClass_(TCocoaSecureTextField) then - begin - Result := fieldEditor; - end; -end; - -procedure TCocoaWindow.windowWillClose(notification: NSNotification); -begin - if Assigned(callback) then - callback.Close; -end; - -procedure TCocoaWindow.windowDidBecomeKey(notification: NSNotification); -begin - if Assigned(callback) then - callback.Activate; -end; - -procedure TCocoaWindow.windowDidResignKey(notification: NSNotification); -begin - if Assigned(callback) then - callback.Deactivate; -end; - -procedure TCocoaWindow.windowDidResize(notification: NSNotification); -begin - if Assigned(callback) then - callback.Resize; -end; - -procedure TCocoaWindow.windowDidMove(notification: NSNotification); -begin - if Assigned(callback) then - callback.Move; -end; - -procedure TCocoaWindow.windowWillEnterFullScreen(notification: NSNotification); -begin - if not isInFullScreen then isInFullScreen := true; - // setting fullscreen flag, prior to the "Fullscreen" has actually been enabled. - // MacOS does 10.7 fullscreen switch with an animation (that's about 1 second long) - // if during that animation there's another call toggleFullScreen() is made - // then macOS produces an output "not in fullscreen state" and ignores the call. -end; - -procedure TCocoaWindow.windowDidEnterFullScreen(notification: NSNotification); -begin - if not isInFullScreen then isInFullScreen := true; -end; - -procedure TCocoaWindow.windowDidExitFullScreen(notification: NSNotification); -begin - if isInFullScreen then isInFullScreen := false; -end; - -procedure TCocoaWindow.dealloc; -begin - if (fieldEditor <> nil) then - begin - fieldEditor.release; - fieldEditor := nil; - end; - inherited dealloc; -end; - -function TCocoaWindow.acceptsFirstResponder: Boolean; -begin - Result := True; -end; - -function TCocoaWindow.canBecomeKeyWindow: Boolean; -begin - Result := Assigned(callback) and callback.CanActivate; -end; - -function TCocoaWindow.becomeFirstResponder: Boolean; -begin - Result := inherited becomeFirstResponder; - // uncommenting the following lines starts an endless focus loop - -// if Assigned(callback) then -// callback.BecomeFirstResponder; -end; - -function TCocoaWindow.resignFirstResponder: Boolean; -begin - Result := inherited resignFirstResponder; -// if Assigned(callback) then -// callback.ResignFirstResponder; -end; - -function TCocoaWindow.lclGetCallback: ICommonCallback; -begin - Result := callback; -end; - -procedure TCocoaWindow.lclClearCallback; -begin - callback := nil; - contentView.lclClearCallback; -end; - -procedure TCocoaWindow.mouseDown(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited mouseDown(event); -end; - -procedure TCocoaWindow.mouseUp(event: NSEvent); -begin - //firedMouseEvent:=true; - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited mouseUp(event); -end; - -procedure TCocoaWindow.rightMouseDown(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseUp(event); -end; - -procedure TCocoaWindow.rightMouseUp(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseDown(event); -end; - -procedure TCocoaWindow.rightMouseDragged(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited rightMouseDragged(event); -end; - -procedure TCocoaWindow.otherMouseDown(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseDown(event); -end; - -procedure TCocoaWindow.otherMouseUp(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseUp(event); -end; - -procedure TCocoaWindow.otherMouseDragged(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then - inherited otherMouseDown(event); -end; - -procedure TCocoaWindow.mouseDragged(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseMove(event) then - inherited mouseDragged(event); -end; - -procedure TCocoaWindow.mouseEntered(event: NSEvent); -begin - inherited mouseEntered(event); -end; - -procedure TCocoaWindow.mouseExited(event: NSEvent); -begin - inherited mouseExited(event); -end; - -procedure TCocoaWindow.mouseMoved(event: NSEvent); -begin - //if not Assigned(callback) or not callback.MouseMove(event) then - inherited mouseMoved(event); -end; - -procedure TCocoaWindow.scrollWheel(event: NSEvent); -begin - if not Assigned(callback) or not callback.scrollWheel(event) then - inherited scrollWheel(event); -end; - -procedure TCocoaWindow.sendEvent(event: NSEvent); -var - Message: NSMutableDictionary; - Handle: HWND; - Msg: Cardinal; - WP: WParam; - LP: LParam; - ResultCode: NSNumber; - Obj: NSObject; - - Epos: NSPoint; - cr : NSRect; - fr : NSRect; - trackEvent: Boolean; -begin - if event.type_ = NSApplicationDefined then - begin - // event which we get through PostMessage or SendMessage - if event.subtype = LCLEventSubTypeMessage then - begin - // extract message data - Message := NSMutableDictionary(event.data1); - Handle := NSNumber(Message.objectForKey(NSMessageWnd)).unsignedIntegerValue; - Msg := NSNumber(Message.objectForKey(NSMessageMsg)).unsignedLongValue; - WP := NSNumber(Message.objectForKey(NSMessageWParam)).integerValue; - LP := NSNumber(Message.objectForKey(NSMessageLParam)).integerValue; - // deliver message and set result if response requested - Obj := NSObject(Handle); - // todo: check that Obj is still a valid NSView/NSWindow - ResultCode := NSNumber.numberWithInteger(Obj.lclDeliverMessage(Msg, WP, LP)); - if event.data2 <> 0 then - Message.setObject_forKey(ResultCode, NSMessageResult) - else - Message.release; - //ResultCode.release; // will be auto-released - end; - end - else - if event.type_ = NSLeftMouseUp then - // This code is introduced here for an odd cocoa feature. - // mouseUp is not fired, if pressed on Window's title. - // (even though mouseDown, mouseMove and mouseDragged are fired) - // (there are some information in the internet, that mouseDown is not firing as well) - // (however this is not true for macOS 10.12) - // The logic below is as following. If mouseUp event arrived - // and mouse position is on the title of the form. - // then try to process the event. If event was not processed, call mouseUp() - // specifically. - begin - Epos:=event.locationInWindow; - fr := frame; - fr.origin.x:=0; - fr.origin.y:=0; - cr := contentRectForFrameRect(fr); - if NSPointInRect(Epos, fr) and not NSPointInRect(Epos, cr) then - begin - firedMouseEvent := false; - inherited sendEvent(event); - if not firedMouseEvent then mouseUp(event); - end - else - inherited sendEvent(event); - end - else - inherited sendEvent(event); -end; - -function TCocoaWindow.draggingEntered(sender: NSDraggingInfoProtocol): NSDragOperation; -var - lTarget: TCustomForm = nil; -begin - Result := NSDragOperationNone; - if (callback <> nil) and (callback.GetTarget() <> nil) and (callback.GetTarget() is TCustomForm) then - lTarget := TCustomForm(callback.GetTarget()); - if (lTarget <> nil) and (lTarget.OnDropFiles <> nil) then - begin - Result := sender.draggingSourceOperationMask(); - end; -end; - -function TCocoaWindow.performDragOperation(sender: NSDraggingInfoProtocol): Boolean; -var - draggedURLs{, lClasses}: NSArray; - lFiles: array of string; - i: Integer; - pboard: NSPasteboard; - lNSStr: NSString; - //lClass: pobjc_class; -begin - Result := False; - pboard := sender.draggingPasteboard(); - - // Multiple strings - draggedURLs := pboard.propertyListForType(NSFilenamesPboardType); - SetLength(lFiles, draggedURLs.count); - for i := 0 to draggedURLs.count-1 do - begin - lNSStr := NSString(draggedURLs.objectAtIndex(i)); - lFiles[i] := NSStringToString(lNSStr); - end; - - // Multiple URLs -> Results in strange URLs with file:// protocol - {if pboard.types.containsObject(NSURLPboardType) then - begin - lClass := NSURL.classClass; - lClasses := NSArray.arrayWithObjects_count(@lClass, 1); - draggedURLs := pboard.readObjectsForClasses_options(lClasses, nil); - SetLength(lFiles, draggedURLs.count); - for i := 0 to draggedURLs.count-1 do - begin - lNSStr := NSURL(draggedURLs.objectAtIndex(i)).absoluteString; - lFiles[i] := NSStringToString(lNSStr); - end; - end;} - - if (Length(lFiles) > 0) and (callback <> nil) and (callback.GetTarget() <> nil) then - TCustomForm(callback.GetTarget()).IntfDropFiles(lFiles); - Result := True; -end; - -procedure TCocoaWindow.lclItemSelected(sender: id); -begin - -end; - -procedure TCocoaWindow.lclSwitchFullScreen(AEnabled: Boolean); -const - fsmask = NSWindowCollectionBehaviorFullScreenPrimary - or - NSWindowCollectionBehaviorFullScreenAuxiliary; -begin - if isInFullScreen = AEnabled then Exit; // nothing to do - - //todo: there are two flavours of full-screen - // (soft) macOS 10.7+ toggleFullScreen() - // (hard) macOS 10.5+ enterFullScreenMode_withOptions() - // the function should be smart enough to figure out the available mode - - isInFullScreen := AEnabled; - if NSAppKitVersionNumber >= NSAppKitVersionNumber10_7 then - begin - if Self.collectionBehavior and fsmask = 0 then - Self.setCollectionBehavior(Self.collectionBehavior or NSWindowCollectionBehaviorFullScreenPrimary); - Self.toggleFullScreen(nil); - end - else - begin - if AEnabled then - begin - fsview := TCocoaWindowContent(contentView); - fsview.fswin := self; - fsview.enterFullScreenMode_withOptions(self.screen, nil); - end else begin - fsview.exitFullScreenModeWithOptions(nil); - self.setContentView(fsview); - fsview := nil; - end; - end; -end; - -function TCocoaWindow.lclIsFullScreen: Boolean; -begin - Result := isInFullScreen; -end; - { TCocoaScrollView } function TCocoaScrollView.lclIsHandle: Boolean; @@ -3364,176 +2474,6 @@ begin end; end; -{ LCLWindowExtension } - -function LCLWindowExtension.lclIsVisible: Boolean; -begin - Result := isVisible; -end; - -procedure LCLWindowExtension.lclSetVisible(AVisible: Boolean); -begin - if AVisible then - orderFrontRegardless - else - orderOut(nil); -end; - -function LCLWindowExtension.lclIsEnabled: Boolean; -begin - Result := contentView.lclIsEnabled; -end; - -procedure LCLWindowExtension.lclSetEnabled(AEnabled: Boolean); -begin - contentView.lclSetEnabled(AEnabled); -end; - -function LCLWindowExtension.lclWindowState: Integer; -const - NSFullScreenWindowMask = 1 shl 14; -begin - if isMiniaturized then - Result := SIZE_MINIMIZED - else - if (styleMask and NSFullScreenWindowMask) <> 0 then - Result := SIZE_FULLSCREEN - else - if isZoomed then - Result := SIZE_MAXIMIZED - else - Result := SIZE_RESTORED; -end; - -procedure LCLWindowExtension.lclInvalidateRect(const r: TRect); -begin - contentView.lclInvalidateRect(r); -end; - -procedure LCLWindowExtension.lclInvalidate; -begin - contentView.lclInvalidate; -end; - -procedure LCLWindowExtension.lclUpdate; -begin - contentView.lclUpdate; -end; - -procedure LCLWindowExtension.lclRelativePos(var Left, Top: Integer); -var - f: NSRect; -begin - if Assigned(screen) then - begin - f:=frame; - Left := Round(f.origin.x); - Top := Round(screen.frame.size.height - f.size.height - f.origin.y); - //debugln('Top:'+dbgs(Top)); - end; -end; - -procedure LCLWindowExtension.lclLocalToScreen(var X, Y:Integer); -var - f: NSRect; -begin - if Assigned(screen) then - begin - f := frame; - inc(X, Round(f.origin.x)); - inc(Y, Round(screen.frame.size.height - f.size.height - f.origin.y)); - end; -end; - -procedure LCLWindowExtension.lclScreenToLocal(var X, Y: Integer); -var - f: NSRect; -begin - if Assigned(screen) then - begin - f := frame; - dec(X, Round(f.origin.x)); - dec(Y, Round(screen.frame.size.height - f.size.height - f.origin.y)); - end; -end; - -function LCLWindowExtension.lclFrame: TRect; -begin - if Assigned(contentView) then - Result:=contentView.lclFrame - else - begin - if Assigned(screen) then - NSToLCLRect(frame, screen.frame.size.height, Result) - else - Result := NSRectToRect(frame); - end; -end; - -function LCLWindowExtension.lclGetTopBarHeight:integer; -var nw,nf: NSRect; -begin - nf:= NSMakeRect (0, 0, 100, 100); - nw:=contentRectForFrameRect(nf); - result:=round(nf.size.height-nw.size.height); -end; - -procedure LCLWindowExtension.lclOffsetMousePos(var Point: NSPoint); -begin - Point.y := contentView.bounds.size.height - Point.y; -end; - -procedure LCLWindowExtension.lclSetFrame(const r: TRect); -var - ns : NSRect; - h : integer; - i : integer; - p : NSPoint; - sc : NSScreen; - srect : NSRect; - fnd: Boolean; -begin - fnd := Assigned(screen); - if fnd then - srect := screen.frame - else - begin - // the window doesn't have screen assigned. - // figuring out the placement based of the Left/Top of the rect - // and NSrects; - p.x:=r.Left; - p.y:=r.Top; - for sc in NSScreen.screens do begin - srect := sc.frame; - fnd := NSPointInRect(p, srect); - if fnd then Break; - end; - end; - - if fnd then - LCLToNSRect(r, srect.size.height, ns) - else - ns := RectToNSRect(r); - - // add topbar height - h:=lclGetTopBarHeight; - ns.size.height:=ns.size.height+h; - ns.origin.y:=ns.origin.y-h; - setFrame_display(ns, isVisible); -end; - -function LCLWindowExtension.lclClientFrame: TRect; -var - wFrame, cFrame: NSRect; -begin - wFrame := frame; - cFrame := contentRectForFrameRect(wFrame); - Result.Left := Round(cFrame.origin.x - wFrame.origin.x); - Result.Top := Round(wFrame.origin.y + wFrame.size.height - cFrame.origin.y - cFrame.size.height); - Result.Right := Result.Left + Round(cFrame.size.width); - Result.Bottom := Result.Top + Round(cFrame.size.height); -end; - { TCocoaListBox } function TCocoaListBox.lclIsHandle: Boolean; diff --git a/lcl/interfaces/cocoa/cocoawindows.pas b/lcl/interfaces/cocoa/cocoawindows.pas new file mode 100644 index 0000000000..05faff0c36 --- /dev/null +++ b/lcl/interfaces/cocoa/cocoawindows.pas @@ -0,0 +1,1116 @@ +{ $Id: $} +{ -------------------------------------------- + cocoawindows.pas - Cocoa internal classes + -------------------------------------------- + + This unit contains the private classhierarchy for the Cocoa implemetations + + ***************************************************************************** + This file is part of the Lazarus Component Library (LCL) + + See the file COPYING.modifiedLGPL.txt, included in this distribution, + for details about the license. + ***************************************************************************** +} +unit CocoaWindows; + +{$mode objfpc}{$H+} +{$modeswitch objectivec1} +{$modeswitch objectivec2} +{$interfaces corba} + +interface + +uses + // rtl+ftl + Types, Classes, SysUtils, + CGGeometry, + // Libs + MacOSAll, CocoaAll, CocoaUtils, CocoaGDIObjects, + cocoa_extra, CocoaPrivate, + // LCL + Forms, LCLType, LCLProc; + +type + + { LCLWindowExtension } + + LCLWindowExtension = objccategory(NSWindow) + function lclIsVisible: Boolean; message 'lclIsVisible'; reintroduce; + procedure lclSetVisible(AVisible: Boolean); message 'lclSetVisible:'; reintroduce; + function lclIsEnabled: Boolean; message 'lclIsEnabled'; reintroduce; + procedure lclSetEnabled(AEnabled: Boolean); message 'lclSetEnabled:'; reintroduce; + + function lclWindowState: Integer; message 'lclWindowState'; reintroduce; + procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce; + procedure lclInvalidate; message 'lclInvalidate'; reintroduce; + procedure lclUpdate; message 'lclUpdate'; reintroduce; + procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce; + procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce; + procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce; + function lclFrame: TRect; message 'lclFrame'; reintroduce; + procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce; + function lclClientFrame: TRect; message 'lclClientFrame'; reintroduce; + function lclGetTopBarHeight:integer; message 'lclGetTopBarHeight'; reintroduce; + procedure lclOffsetMousePos(var Point: NSPoint); message 'lclOffsetMousePos:'; reintroduce; + end; + + { IWindowCallback } + + IWindowCallback = interface(ICommonCallBack) + function CanActivate: Boolean; + procedure Activate; + procedure Deactivate; + procedure CloseQuery(var CanClose: Boolean); + procedure Close; + procedure Resize; + procedure Move; + + function GetEnabled: Boolean; + procedure SetEnabled(AValue: Boolean); + + property Enabled: Boolean read GetEnabled write SetEnabled; + end; + + { TCocoaPanel } + + TCocoaPanel = objcclass(NSPanel, NSWindowDelegateProtocol) + protected + function windowShouldClose(sender : id): LongBool; message 'windowShouldClose:'; + procedure windowWillClose(notification: NSNotification); message 'windowWillClose:'; + procedure windowDidBecomeKey(notification: NSNotification); message 'windowDidBecomeKey:'; + procedure windowDidResignKey(notification: NSNotification); message 'windowDidResignKey:'; + procedure windowDidResize(notification: NSNotification); message 'windowDidResize:'; + procedure windowDidMove(notification: NSNotification); message 'windowDidMove:'; + public + callback: IWindowCallback; + function acceptsFirstResponder: Boolean; override; + function canBecomeKeyWindow: Boolean; override; + function becomeFirstResponder: Boolean; override; + function resignFirstResponder: Boolean; override; + function lclGetCallback: ICommonCallback; override; + procedure lclClearCallback; override; + // mouse + procedure mouseDown(event: NSEvent); override; + procedure mouseUp(event: NSEvent); override; + procedure rightMouseDown(event: NSEvent); override; + procedure rightMouseUp(event: NSEvent); override; + procedure rightMouseDragged(event: NSEvent); override; + procedure otherMouseDown(event: NSEvent); override; + procedure otherMouseUp(event: NSEvent); override; + procedure otherMouseDragged(event: NSEvent); override; + procedure mouseDragged(event: NSEvent); override; + procedure mouseEntered(event: NSEvent); override; + procedure mouseExited(event: NSEvent); override; + procedure mouseMoved(event: NSEvent); override; + procedure sendEvent(event: NSEvent); override; + function lclIsHandle: Boolean; override; + end; + + { TCocoaWindow } + + TCocoaWindowContent = objcclass; + + TCocoaWindow = objcclass(NSWindow, NSWindowDelegateProtocol) + protected + fieldEditor: TCocoaFieldEditor; + firedMouseEvent: Boolean; + isInFullScreen: Boolean; + fsview: TCocoaWindowContent; + function windowShouldClose(sender : id): LongBool; message 'windowShouldClose:'; + function windowWillReturnFieldEditor_toObject(sender: NSWindow; client: id): id; message 'windowWillReturnFieldEditor:toObject:'; + procedure windowWillClose(notification: NSNotification); message 'windowWillClose:'; + procedure windowDidBecomeKey(notification: NSNotification); message 'windowDidBecomeKey:'; + procedure windowDidResignKey(notification: NSNotification); message 'windowDidResignKey:'; + procedure windowDidResize(notification: NSNotification); message 'windowDidResize:'; + procedure windowDidMove(notification: NSNotification); message 'windowDidMove:'; + // fullscreen notifications are only reported for 10.7 fullscreen + procedure windowWillEnterFullScreen(notification: NSNotification); message 'windowWillEnterFullScreen:'; + procedure windowDidEnterFullScreen(notification: NSNotification); message 'windowDidEnterFullScreen:'; + procedure windowDidExitFullScreen(notification: NSNotification); message 'windowDidExitFullScreen:'; + public + callback: IWindowCallback; + LCLForm: TCustomForm; + procedure dealloc; override; + function acceptsFirstResponder: Boolean; override; + function canBecomeKeyWindow: Boolean; override; + function becomeFirstResponder: Boolean; override; + function resignFirstResponder: Boolean; override; + function lclGetCallback: ICommonCallback; override; + procedure lclClearCallback; override; + // mouse + procedure mouseDown(event: NSEvent); override; + procedure mouseUp(event: NSEvent); override; + procedure rightMouseDown(event: NSEvent); override; + procedure rightMouseUp(event: NSEvent); override; + procedure rightMouseDragged(event: NSEvent); override; + procedure otherMouseDown(event: NSEvent); override; + procedure otherMouseUp(event: NSEvent); override; + procedure otherMouseDragged(event: NSEvent); override; + procedure mouseDragged(event: NSEvent); override; + procedure mouseEntered(event: NSEvent); override; + procedure mouseExited(event: NSEvent); override; + procedure mouseMoved(event: NSEvent); override; + procedure scrollWheel(event: NSEvent); override; + procedure sendEvent(event: NSEvent); override; + function lclIsHandle: Boolean; override; + // NSDraggingDestinationCategory + function draggingEntered(sender: NSDraggingInfoProtocol): NSDragOperation; override; + function performDragOperation(sender: NSDraggingInfoProtocol): Boolean; override; + // menu support + procedure lclItemSelected(sender: id); message 'lclItemSelected:'; + + procedure lclSwitchFullScreen(AEnabled: Boolean); message 'lclSwitchFullScreen:'; + function lclIsFullScreen: Boolean; message 'lclIsFullScreen'; + end; + + { TCocoaDesignOverlay } + + TCocoaDesignOverlay = objcclass(NSView) + callback : ICommonCallback; + procedure drawRect(r: NSRect); override; + function acceptsFirstResponder: Boolean; override; + function hitTest(aPoint: NSPoint): NSView; override; + function lclGetCallback: ICommonCallback; override; + procedure lclClearCallback; override; + end; + + { TCocoaWindowContent } + + TCocoaWindowContent = objcclass(TCocoaCustomControl) + protected + procedure didBecomeKeyNotification(sender: NSNotification); message 'didBecomeKeyNotification:'; + procedure didResignKeyNotification(sender: NSNotification); message 'didResignKeyNotification:'; + public + isembedded: Boolean; // true - if the content is inside of another control, false - if the content is in its own window; + ownwin: NSWindow; + fswin: NSWindow; // window that was used as a content prior to switching to old-school fullscreen + popup_parent: HWND; // if not 0, indicates that we should set the popup parent + overlay: NSView; + function performKeyEquivalent(event: NSEvent): Boolean; override; + procedure resolvePopupParent(); message 'resolvePopupParent'; + function lclOwnWindow: NSWindow; message 'lclOwnWindow'; + procedure lclSetFrame(const r: TRect); override; + function lclFrame: TRect; override; + procedure viewDidMoveToSuperview; override; + procedure viewDidMoveToWindow; override; + procedure viewWillMoveToWindow(newWindow: CocoaAll.NSWindow); override; + procedure dealloc; override; + procedure setHidden(aisHidden: Boolean); override; + function lclIsHandle: Boolean; override; + procedure didAddSubview(aview: NSView); override; + end; + +implementation + +{ TCocoaDesignOverlay } + +procedure TCocoaDesignOverlay.drawRect(r: NSRect); +begin + if Assigned(callback) then + callback.DrawOverlay(NSGraphicsContext.currentContext, bounds, r); + inherited drawRect(r); +end; + +function TCocoaDesignOverlay.acceptsFirstResponder: Boolean; +begin + Result:=false; // no focus +end; + +function TCocoaDesignOverlay.hitTest(aPoint: NSPoint): NSView; +begin + Result:=nil; // no mouse +end; + +function TCocoaDesignOverlay.lclGetCallback: ICommonCallback; +begin + Result := callback; +end; + +procedure TCocoaDesignOverlay.lclClearCallback; +begin + callback := nil; +end; + +{ TCocoaWindowContent } + +function TCocoaWindowContent.lclIsHandle: Boolean; +begin + Result:=true; +end; + +procedure TCocoaWindowContent.didAddSubview(aview: NSView); +begin + if Assigned(aview) and Assigned(overlay) and (overlay<>aview) then + begin + overlay.retain; + overlay.removeFromSuperview; + addSubview_positioned_relativeTo(overlay, NSWindowAbove, nil); + end; + inherited didAddSubview(aview); +end; + +procedure TCocoaWindowContent.didBecomeKeyNotification(sender: NSNotification); +begin + if Assigned(callback) then + callback.DidBecomeKeyNotification; +end; + +procedure TCocoaWindowContent.didResignKeyNotification(sender: NSNotification); +begin + if Assigned(callback) then + callback.DidResignKeyNotification; +end; + +function TCocoaWindowContent.performKeyEquivalent(event: NSEvent): Boolean; +begin + // this event servers all TextEdit, ComboBoxes and Memos on a form. + // to do short keys for copy, paste, cut, etc... + Result := false; + NSResponderHotKeys(self, event, Result); + if not Result then + Result:=inherited performKeyEquivalent(event); +end; + +procedure TCocoaWindowContent.resolvePopupParent(); +var + lWindow: NSWindow; +begin + lWindow := nil; + if (popup_parent <> 0) then + begin + if (NSObject(popup_parent).isKindOfClass(TCocoaWindowContent)) then + begin + if (not TCocoaWindowContent(popup_parent).isembedded) then + lWindow := NSWindow(TCocoaWindowContent(popup_parent).window); + end + else + begin + lWindow := NSWindow(popup_parent); + end; + end; + if lWindow <> nil then + lWindow.addChildWindow_ordered(Self.window, NSWindowAbove); + popup_parent := 0; +end; + +function TCocoaWindowContent.lclOwnWindow: NSWindow; +begin + if not isembedded then + Result := NSWindow(window) + else + Result := nil; +end; + +procedure TCocoaWindowContent.lclSetFrame(const r: TRect); +begin + if isembedded then + inherited lclSetFrame(r) + else + window.lclSetFrame(r); +end; + +function TCocoaWindowContent.lclFrame: TRect; +var + wfrm : TRect; +begin + Result := inherited lclFrame; + if not isembedded then + begin + //Window bounds should return "client rect" in screen coordinates + if Assigned(window.screen) then + NSToLCLRect(window.frame, window.screen.frame.size.height, wfrm) + else + wfrm := NSRectToRect(frame); + OffsetRect(Result, -Result.Left+wfrm.Left, -Result.Top+wfrm.Top); + end; +end; + +procedure TCocoaWindowContent.viewDidMoveToSuperview; +begin + inherited viewDidMoveToSuperview; +end; + +procedure TCocoaWindowContent.viewDidMoveToWindow; +begin + isembedded := window.contentView <> self; + if isembedded then + begin + if Assigned(ownwin) then + ownwin.close; + ownwin := nil; + end + else + begin + ownwin := NSWindow(window); + end; + inherited viewDidMoveToWindow; +end; + +procedure TCocoaWindowContent.viewWillMoveToWindow(newWindow: CocoaAll.NSWindow); +begin + if newWindow<>nil then + newWindow.setAcceptsMouseMovedEvents(True); + if not isembedded and (newWindow <> window) then + begin + if Assigned(window) then + window.close; + ownwin := nil; + isembedded := false; + end; + inherited viewWillMoveToWindow(newWindow); +end; + +procedure TCocoaWindowContent.dealloc; +begin + inherited dealloc; +end; + +procedure TCocoaWindowContent.setHidden(aisHidden: Boolean); +begin + if isembedded then + begin + inherited setHidden(aisHidden); + end + else + begin + if aisHidden and window.isVisible then + window.orderOut(nil) + else + if not aisHidden and not window.isVisible then + window.orderBack(nil); + end; +end; + +{ TCocoaPanel } + +function TCocoaPanel.lclIsHandle: Boolean; +begin + Result:=true; +end; + +function TCocoaPanel.windowShouldClose(sender: id): LongBool; +var + canClose: Boolean; +begin + canClose := True; + if Assigned(callback) then + callback.CloseQuery(canClose); + Result := canClose; +end; + +procedure TCocoaPanel.windowWillClose(notification: NSNotification); +begin + if Assigned(callback) then + callback.Close; +end; + +procedure TCocoaPanel.windowDidBecomeKey(notification: NSNotification); +begin + if Assigned(callback) then + callback.Activate; +end; + +procedure TCocoaPanel.windowDidResignKey(notification: NSNotification); +begin + if Assigned(callback) then + callback.Deactivate; +end; + +procedure TCocoaPanel.windowDidResize(notification: NSNotification); +begin + if Assigned(callback) then + callback.Resize; +end; + +procedure TCocoaPanel.windowDidMove(notification: NSNotification); +begin + if Assigned(callback) then + callback.Move; +end; + +function TCocoaPanel.acceptsFirstResponder: Boolean; +begin + Result := True; +end; + +function TCocoaPanel.canBecomeKeyWindow: Boolean; +begin + Result := Assigned(callback) and callback.CanActivate; +end; + +function TCocoaPanel.becomeFirstResponder: Boolean; +begin + Result := inherited becomeFirstResponder; +// if Assigned(callback) then +// callback.BecomeFirstResponder; +end; + +function TCocoaPanel.resignFirstResponder: Boolean; +begin + Result := inherited resignFirstResponder; +// if Assigned(callback) then +// callback.ResignFirstResponder; +end; + +function TCocoaPanel.lclGetCallback: ICommonCallback; +begin + Result := callback; +end; + +procedure TCocoaPanel.lclClearCallback; +begin + callback := nil; + contentView.lclClearCallback; +end; + +procedure TCocoaPanel.mouseDown(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited mouseDown(event); +end; + +procedure TCocoaPanel.mouseUp(event: NSEvent); +begin + if Assigned(callback) then callback.MouseUpDownEvent(event); + inherited mouseUp(event); +end; + +procedure TCocoaPanel.rightMouseDown(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseUp(event); +end; + +procedure TCocoaPanel.rightMouseUp(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseDown(event); +end; + +procedure TCocoaPanel.rightMouseDragged(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseDragged(event); +end; + +procedure TCocoaPanel.otherMouseDown(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseDown(event); +end; + +procedure TCocoaPanel.otherMouseUp(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseUp(event); +end; + +procedure TCocoaPanel.otherMouseDragged(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseDown(event); +end; + +procedure TCocoaPanel.mouseDragged(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseMove(event) then + inherited mouseDragged(event); +end; + +procedure TCocoaPanel.mouseEntered(event: NSEvent); +begin + inherited mouseEntered(event); +end; + +procedure TCocoaPanel.mouseExited(event: NSEvent); +begin + inherited mouseExited(event); +end; + +procedure TCocoaPanel.mouseMoved(event: NSEvent); +begin + if not Assigned(callback) or not callback.MouseMove(event) then + inherited mouseMoved(event); +end; + +procedure TCocoaPanel.sendEvent(event: NSEvent); +var + Message: NSMutableDictionary; + Handle: HWND; + Msg: Cardinal; + WP: WParam; + LP: LParam; + ResultCode: NSNumber; + Obj: NSObject; +begin + if event.type_ = NSApplicationDefined then + begin + // event which we get through PostMessage or SendMessage + if event.subtype = LCLEventSubTypeMessage then + begin + // extract message data + Message := NSMutableDictionary(event.data1); + Handle := NSNumber(Message.objectForKey(NSMessageWnd)).unsignedIntegerValue; + Msg := NSNumber(Message.objectForKey(NSMessageMsg)).unsignedLongValue; + WP := NSNumber(Message.objectForKey(NSMessageWParam)).integerValue; + LP := NSNumber(Message.objectForKey(NSMessageLParam)).integerValue; + Obj := NSObject(Handle); + // deliver message and set result if response requested + // todo: check that Obj is still a valid NSView/NSWindow + ResultCode := NSNumber.numberWithInteger(Obj.lclDeliverMessage(Msg, WP, LP)); + if event.data2 <> 0 then + Message.setObject_forKey(ResultCode, NSMessageResult) + else + Message.release; + //ResultCode.release; // will be auto-released + end; + end + else + inherited sendEvent(event); +end; + +{ TCocoaWindow } + +function TCocoaWindow.lclIsHandle: Boolean; +begin + Result:=true; +end; + +function TCocoaWindow.windowShouldClose(sender: id): LongBool; +var + canClose: Boolean; +begin + canClose := True; + if Assigned(callback) then + callback.CloseQuery(canClose); + Result := canClose; +end; + +function TCocoaWindow.windowWillReturnFieldEditor_toObject(sender: NSWindow; + client: id): id; +begin + //DebugLn('[TCocoaWindow.windowWillReturnFieldEditor_toObject]'); + Result := nil; + if (fieldEditor = nil) then + begin + fieldEditor := TCocoaFieldEditor.alloc.init; + fieldEditor.setFieldEditor(True); + end; + if client.isKindOfClass_(TCocoaTextField) or + client.isKindOfClass_(TCocoaSecureTextField) then + begin + Result := fieldEditor; + end; +end; + +procedure TCocoaWindow.windowWillClose(notification: NSNotification); +begin + if Assigned(callback) then + callback.Close; +end; + +procedure TCocoaWindow.windowDidBecomeKey(notification: NSNotification); +begin + if Assigned(callback) then + callback.Activate; +end; + +procedure TCocoaWindow.windowDidResignKey(notification: NSNotification); +begin + if Assigned(callback) then + callback.Deactivate; +end; + +procedure TCocoaWindow.windowDidResize(notification: NSNotification); +begin + if Assigned(callback) then + callback.Resize; +end; + +procedure TCocoaWindow.windowDidMove(notification: NSNotification); +begin + if Assigned(callback) then + callback.Move; +end; + +procedure TCocoaWindow.windowWillEnterFullScreen(notification: NSNotification); +begin + if not isInFullScreen then isInFullScreen := true; + // setting fullscreen flag, prior to the "Fullscreen" has actually been enabled. + // MacOS does 10.7 fullscreen switch with an animation (that's about 1 second long) + // if during that animation there's another call toggleFullScreen() is made + // then macOS produces an output "not in fullscreen state" and ignores the call. +end; + +procedure TCocoaWindow.windowDidEnterFullScreen(notification: NSNotification); +begin + if not isInFullScreen then isInFullScreen := true; +end; + +procedure TCocoaWindow.windowDidExitFullScreen(notification: NSNotification); +begin + if isInFullScreen then isInFullScreen := false; +end; + +procedure TCocoaWindow.dealloc; +begin + if (fieldEditor <> nil) then + begin + fieldEditor.release; + fieldEditor := nil; + end; + inherited dealloc; +end; + +function TCocoaWindow.acceptsFirstResponder: Boolean; +begin + Result := True; +end; + +function TCocoaWindow.canBecomeKeyWindow: Boolean; +begin + Result := Assigned(callback) and callback.CanActivate; +end; + +function TCocoaWindow.becomeFirstResponder: Boolean; +begin + Result := inherited becomeFirstResponder; + // uncommenting the following lines starts an endless focus loop + +// if Assigned(callback) then +// callback.BecomeFirstResponder; +end; + +function TCocoaWindow.resignFirstResponder: Boolean; +begin + Result := inherited resignFirstResponder; +// if Assigned(callback) then +// callback.ResignFirstResponder; +end; + +function TCocoaWindow.lclGetCallback: ICommonCallback; +begin + Result := callback; +end; + +procedure TCocoaWindow.lclClearCallback; +begin + callback := nil; + contentView.lclClearCallback; +end; + +procedure TCocoaWindow.mouseDown(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited mouseDown(event); +end; + +procedure TCocoaWindow.mouseUp(event: NSEvent); +begin + //firedMouseEvent:=true; + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited mouseUp(event); +end; + +procedure TCocoaWindow.rightMouseDown(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseUp(event); +end; + +procedure TCocoaWindow.rightMouseUp(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseDown(event); +end; + +procedure TCocoaWindow.rightMouseDragged(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited rightMouseDragged(event); +end; + +procedure TCocoaWindow.otherMouseDown(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseDown(event); +end; + +procedure TCocoaWindow.otherMouseUp(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseUp(event); +end; + +procedure TCocoaWindow.otherMouseDragged(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseUpDownEvent(event) then + inherited otherMouseDown(event); +end; + +procedure TCocoaWindow.mouseDragged(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseMove(event) then + inherited mouseDragged(event); +end; + +procedure TCocoaWindow.mouseEntered(event: NSEvent); +begin + inherited mouseEntered(event); +end; + +procedure TCocoaWindow.mouseExited(event: NSEvent); +begin + inherited mouseExited(event); +end; + +procedure TCocoaWindow.mouseMoved(event: NSEvent); +begin + //if not Assigned(callback) or not callback.MouseMove(event) then + inherited mouseMoved(event); +end; + +procedure TCocoaWindow.scrollWheel(event: NSEvent); +begin + if not Assigned(callback) or not callback.scrollWheel(event) then + inherited scrollWheel(event); +end; + +procedure TCocoaWindow.sendEvent(event: NSEvent); +var + Message: NSMutableDictionary; + Handle: HWND; + Msg: Cardinal; + WP: WParam; + LP: LParam; + ResultCode: NSNumber; + Obj: NSObject; + + Epos: NSPoint; + cr : NSRect; + fr : NSRect; + trackEvent: Boolean; +begin + if event.type_ = NSApplicationDefined then + begin + // event which we get through PostMessage or SendMessage + if event.subtype = LCLEventSubTypeMessage then + begin + // extract message data + Message := NSMutableDictionary(event.data1); + Handle := NSNumber(Message.objectForKey(NSMessageWnd)).unsignedIntegerValue; + Msg := NSNumber(Message.objectForKey(NSMessageMsg)).unsignedLongValue; + WP := NSNumber(Message.objectForKey(NSMessageWParam)).integerValue; + LP := NSNumber(Message.objectForKey(NSMessageLParam)).integerValue; + // deliver message and set result if response requested + Obj := NSObject(Handle); + // todo: check that Obj is still a valid NSView/NSWindow + ResultCode := NSNumber.numberWithInteger(Obj.lclDeliverMessage(Msg, WP, LP)); + if event.data2 <> 0 then + Message.setObject_forKey(ResultCode, NSMessageResult) + else + Message.release; + //ResultCode.release; // will be auto-released + end; + end + else + if event.type_ = NSLeftMouseUp then + // This code is introduced here for an odd cocoa feature. + // mouseUp is not fired, if pressed on Window's title. + // (even though mouseDown, mouseMove and mouseDragged are fired) + // (there are some information in the internet, that mouseDown is not firing as well) + // (however this is not true for macOS 10.12) + // The logic below is as following. If mouseUp event arrived + // and mouse position is on the title of the form. + // then try to process the event. If event was not processed, call mouseUp() + // specifically. + begin + Epos:=event.locationInWindow; + fr := frame; + fr.origin.x:=0; + fr.origin.y:=0; + cr := contentRectForFrameRect(fr); + if NSPointInRect(Epos, fr) and not NSPointInRect(Epos, cr) then + begin + firedMouseEvent := false; + inherited sendEvent(event); + if not firedMouseEvent then mouseUp(event); + end + else + inherited sendEvent(event); + end + else + inherited sendEvent(event); +end; + +function TCocoaWindow.draggingEntered(sender: NSDraggingInfoProtocol): NSDragOperation; +var + lTarget: TCustomForm = nil; +begin + Result := NSDragOperationNone; + if (callback <> nil) and (callback.GetTarget() <> nil) and (callback.GetTarget() is TCustomForm) then + lTarget := TCustomForm(callback.GetTarget()); + if (lTarget <> nil) and (lTarget.OnDropFiles <> nil) then + begin + Result := sender.draggingSourceOperationMask(); + end; +end; + +function TCocoaWindow.performDragOperation(sender: NSDraggingInfoProtocol): Boolean; +var + draggedURLs{, lClasses}: NSArray; + lFiles: array of string; + i: Integer; + pboard: NSPasteboard; + lNSStr: NSString; + //lClass: pobjc_class; +begin + Result := False; + pboard := sender.draggingPasteboard(); + + // Multiple strings + draggedURLs := pboard.propertyListForType(NSFilenamesPboardType); + SetLength(lFiles, draggedURLs.count); + for i := 0 to draggedURLs.count-1 do + begin + lNSStr := NSString(draggedURLs.objectAtIndex(i)); + lFiles[i] := NSStringToString(lNSStr); + end; + + // Multiple URLs -> Results in strange URLs with file:// protocol + {if pboard.types.containsObject(NSURLPboardType) then + begin + lClass := NSURL.classClass; + lClasses := NSArray.arrayWithObjects_count(@lClass, 1); + draggedURLs := pboard.readObjectsForClasses_options(lClasses, nil); + SetLength(lFiles, draggedURLs.count); + for i := 0 to draggedURLs.count-1 do + begin + lNSStr := NSURL(draggedURLs.objectAtIndex(i)).absoluteString; + lFiles[i] := NSStringToString(lNSStr); + end; + end;} + + if (Length(lFiles) > 0) and (callback <> nil) and (callback.GetTarget() <> nil) then + TCustomForm(callback.GetTarget()).IntfDropFiles(lFiles); + Result := True; +end; + +procedure TCocoaWindow.lclItemSelected(sender: id); +begin + +end; + +procedure TCocoaWindow.lclSwitchFullScreen(AEnabled: Boolean); +const + fsmask = NSWindowCollectionBehaviorFullScreenPrimary + or + NSWindowCollectionBehaviorFullScreenAuxiliary; +begin + if isInFullScreen = AEnabled then Exit; // nothing to do + + //todo: there are two flavours of full-screen + // (soft) macOS 10.7+ toggleFullScreen() + // (hard) macOS 10.5+ enterFullScreenMode_withOptions() + // the function should be smart enough to figure out the available mode + + isInFullScreen := AEnabled; + if NSAppKitVersionNumber >= NSAppKitVersionNumber10_7 then + begin + if Self.collectionBehavior and fsmask = 0 then + Self.setCollectionBehavior(Self.collectionBehavior or NSWindowCollectionBehaviorFullScreenPrimary); + Self.toggleFullScreen(nil); + end + else + begin + if AEnabled then + begin + fsview := TCocoaWindowContent(contentView); + fsview.fswin := self; + fsview.enterFullScreenMode_withOptions(self.screen, nil); + end else begin + fsview.exitFullScreenModeWithOptions(nil); + self.setContentView(fsview); + fsview := nil; + end; + end; +end; + +function TCocoaWindow.lclIsFullScreen: Boolean; +begin + Result := isInFullScreen; +end; + +{ LCLWindowExtension } + +function LCLWindowExtension.lclIsVisible: Boolean; +begin + Result := isVisible; +end; + +procedure LCLWindowExtension.lclSetVisible(AVisible: Boolean); +begin + if AVisible then + orderFrontRegardless + else + orderOut(nil); +end; + +function LCLWindowExtension.lclIsEnabled: Boolean; +begin + Result := contentView.lclIsEnabled; +end; + +procedure LCLWindowExtension.lclSetEnabled(AEnabled: Boolean); +begin + contentView.lclSetEnabled(AEnabled); +end; + +function LCLWindowExtension.lclWindowState: Integer; +const + NSFullScreenWindowMask = 1 shl 14; +begin + if isMiniaturized then + Result := SIZE_MINIMIZED + else + if (styleMask and NSFullScreenWindowMask) <> 0 then + Result := SIZE_FULLSCREEN + else + if isZoomed then + Result := SIZE_MAXIMIZED + else + Result := SIZE_RESTORED; +end; + +procedure LCLWindowExtension.lclInvalidateRect(const r: TRect); +begin + contentView.lclInvalidateRect(r); +end; + +procedure LCLWindowExtension.lclInvalidate; +begin + contentView.lclInvalidate; +end; + +procedure LCLWindowExtension.lclUpdate; +begin + contentView.lclUpdate; +end; + +procedure LCLWindowExtension.lclRelativePos(var Left, Top: Integer); +var + f: NSRect; +begin + if Assigned(screen) then + begin + f:=frame; + Left := Round(f.origin.x); + Top := Round(screen.frame.size.height - f.size.height - f.origin.y); + //debugln('Top:'+dbgs(Top)); + end; +end; + +procedure LCLWindowExtension.lclLocalToScreen(var X, Y:Integer); +var + f: NSRect; +begin + if Assigned(screen) then + begin + f := frame; + inc(X, Round(f.origin.x)); + inc(Y, Round(screen.frame.size.height - f.size.height - f.origin.y)); + end; +end; + +procedure LCLWindowExtension.lclScreenToLocal(var X, Y: Integer); +var + f: NSRect; +begin + if Assigned(screen) then + begin + f := frame; + dec(X, Round(f.origin.x)); + dec(Y, Round(screen.frame.size.height - f.size.height - f.origin.y)); + end; +end; + +function LCLWindowExtension.lclFrame: TRect; +begin + if Assigned(contentView) then + Result:=contentView.lclFrame + else + begin + if Assigned(screen) then + NSToLCLRect(frame, screen.frame.size.height, Result) + else + Result := NSRectToRect(frame); + end; +end; + +function LCLWindowExtension.lclGetTopBarHeight:integer; +var nw,nf: NSRect; +begin + nf:= NSMakeRect (0, 0, 100, 100); + nw:=contentRectForFrameRect(nf); + result:=round(nf.size.height-nw.size.height); +end; + +procedure LCLWindowExtension.lclOffsetMousePos(var Point: NSPoint); +begin + Point.y := contentView.bounds.size.height - Point.y; +end; + +procedure LCLWindowExtension.lclSetFrame(const r: TRect); +var + ns : NSRect; + h : integer; + i : integer; + p : NSPoint; + sc : NSScreen; + srect : NSRect; + fnd: Boolean; +begin + fnd := Assigned(screen); + if fnd then + srect := screen.frame + else + begin + // the window doesn't have screen assigned. + // figuring out the placement based of the Left/Top of the rect + // and NSrects; + p.x:=r.Left; + p.y:=r.Top; + for sc in NSScreen.screens do begin + srect := sc.frame; + fnd := NSPointInRect(p, srect); + if fnd then Break; + end; + end; + + if fnd then + LCLToNSRect(r, srect.size.height, ns) + else + ns := RectToNSRect(r); + + // add topbar height + h:=lclGetTopBarHeight; + ns.size.height:=ns.size.height+h; + ns.origin.y:=ns.origin.y-h; + setFrame_display(ns, isVisible); +end; + +function LCLWindowExtension.lclClientFrame: TRect; +var + wFrame, cFrame: NSRect; +begin + wFrame := frame; + cFrame := contentRectForFrameRect(wFrame); + Result.Left := Round(cFrame.origin.x - wFrame.origin.x); + Result.Top := Round(wFrame.origin.y + wFrame.size.height - cFrame.origin.y - cFrame.size.height); + Result.Right := Result.Left + Round(cFrame.size.width); + Result.Bottom := Result.Top + Round(cFrame.size.height); +end; + +end. + diff --git a/lcl/interfaces/cocoa/cocoawsforms.pp b/lcl/interfaces/cocoa/cocoawsforms.pp index f6a0589eaf..d5454b10c0 100644 --- a/lcl/interfaces/cocoa/cocoawsforms.pp +++ b/lcl/interfaces/cocoa/cocoawsforms.pp @@ -30,7 +30,7 @@ uses // Widgetset WSForms, WSLCLClasses, WSProc, LCLMessageGlue, // LCL Cocoa - CocoaPrivate, CocoaUtils, CocoaWSCommon, CocoaWSStdCtrls, CocoaWSMenus; + CocoaPrivate, CocoaUtils, CocoaWSCommon, CocoaWSStdCtrls, CocoaWSMenus, CocoaWindows; type { TLCLWindowCallback } diff --git a/lcl/interfaces/lcl.lpk b/lcl/interfaces/lcl.lpk index 74889b7163..b0951042ad 100644 --- a/lcl/interfaces/lcl.lpk +++ b/lcl/interfaces/lcl.lpk @@ -129,7 +129,7 @@ end;"/> - + @@ -2371,6 +2371,11 @@ end;"/> + + + + +