lazarus/lcl/interfaces/cocoa/cocoawsforms.pas

995 lines
31 KiB
ObjectPascal

{ $Id: cocoawsforms.pp 12783 2007-11-08 11:45:39Z tombo $}
{
*****************************************************************************
* CocoaWSForms.pp *
* ------------ *
* *
* *
*****************************************************************************
*****************************************************************************
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 CocoaWSForms;
{$mode objfpc}{$H+}
{$modeswitch objectivec1}
{$include cocoadefines.inc}
interface
uses
// RTL,FCL
MacOSAll, CocoaAll, Classes,
// LCL
Controls, Forms, Graphics, LCLType, Messages, LMessages, LCLProc,
// Widgetset
WSForms, WSLCLClasses, WSProc, LCLMessageGlue,
// LCL Cocoa
CocoaPrivate, CocoaUtils, CocoaWSCommon, CocoaWSStdCtrls, CocoaWSMenus,
CocoaWindows, CocoaScrollers, cocoa_extra;
type
{ TLCLWindowCallback }
TLCLWindowCallback = class(TLCLCommonCallBack, IWindowCallback)
private
IsActivating: boolean;
public
window : CocoaAll.NSWindow;
constructor Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView); override;
destructor Destroy; override;
function CanActivate: Boolean; virtual;
procedure Activate; virtual;
procedure Deactivate; virtual;
procedure CloseQuery(var CanClose: Boolean); virtual;
procedure Close; virtual;
procedure Resize; virtual;
procedure Move; virtual;
function GetEnabled: Boolean; virtual;
procedure SetEnabled(AValue: Boolean); virtual;
function AcceptFilesDrag: Boolean;
procedure DropFiles(const FileNames: array of string);
property Enabled: Boolean read GetEnabled write SetEnabled;
end;
{ TCocoaWSScrollingWinControl }
TCocoaWSScrollingWinControl = class(TWSScrollingWinControl)
private
protected
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
end;
{ TCocoaWSScrollBox }
TCocoaWSScrollBox = class(TWSScrollBox)
private
protected
public
end;
{ TCocoaWSCustomFrame }
TCocoaWSCustomFrame = class(TWSCustomFrame)
private
protected
public
end;
{ TCocoaWSFrame }
TCocoaWSFrame = class(TWSFrame)
private
protected
public
end;
{ TCocoaWSCustomForm }
TCocoaWSCustomFormClass = class of TCocoaWSCustomForm;
TCocoaWSCustomForm = class(TWSCustomForm)
private
class function GetStyleMaskFor(ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons): NSUInteger;
class procedure UpdateWindowIcons(AWindow: NSWindow; ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons);
public
class procedure UpdateWindowMask(AWindow: NSWindow; ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons);
class function GetWindowFromHandle(const ACustomForm: TCustomForm): TCocoaWindow;
class function GetWindowContentFromHandle(const ACustomForm: TCustomForm): TCocoaWindowContent;
published
class function AllocWindowHandle: TCocoaWindow; virtual;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure CloseModal(const ACustomForm: TCustomForm); override;
class procedure ShowModal(const ACustomForm: TCustomForm); override;
class procedure SetModalResult(const ACustomForm: TCustomForm; ANewValue: TModalResult); override;
class procedure SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte); override;
class procedure SetBorderIcons(const AForm: TCustomForm; const ABorderIcons: TBorderIcons); override;
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
class procedure SetRealPopupParent(const ACustomForm: TCustomForm;
const APopupParent: TCustomForm); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
{need to override these }
class function GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class function GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
end;
{ TCocoaWSForm }
TCocoaWSForm = class(TWSForm)
private
protected
public
end;
{ TCocoaWSHintWindow }
TCocoaWSHintWindow = class(TWSHintWindow)
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
end;
{ TCocoaWSScreen }
TCocoaWSScreen = class(TWSScreen)
private
protected
public
end;
{ TCocoaWSApplicationProperties }
TCocoaWSApplicationProperties = class(TWSApplicationProperties)
private
protected
public
end;
procedure ArrangeTabOrder(const AWinControl: TWinControl);
function HWNDToForm(AFormHandle: HWND): TCustomForm;
procedure WindowSetFormStyle(win: NSWindow; AFormStyle: TFormStyle);
implementation
uses
CocoaInt;
const
// The documentation says we should use NSNormalWindowLevel=4 for normal forms,
// but in practice this causes the issue http://bugs.freepascal.org/view.php?id=28473
// The only value that works is zero =(
FormStyleToWindowLevel: array[TFormStyle] of NSInteger = (
{ fsNormal } 0,
{ fsMDIChild } 0,
{ fsMDIForm } 0,
{ fsStayOnTop } 9, // NSStatusWindowLevel
{ fsSplash } 9, // NSStatusWindowLevel
{ fsSystemStayOnTop } 10 // NSModalPanelWindowLevel
);
// Window levels make the form always stay on top, so if it is supposed to
// stay on top of the app only, then a workaround is to hide it while the app
// is deactivated
FormStyleToHideOnDeactivate: array[TFormStyle] of Boolean = (
{ fsNormal } False,
{ fsMDIChild } False,
{ fsMDIForm } False,
{ fsStayOnTop } True,
{ fsSplash } True,
{ fsSystemStayOnTop } False
);
HintWindowLevel = 11; // NSPopUpMenuWindowLevel
function GetDesigningBorderStyle(const AForm: TCustomForm): TFormBorderStyle;
begin
if csDesigning in AForm.ComponentState then
Result := bsSizeable
else
Result := AForm.BorderStyle;
end;
procedure WindowSetFormStyle(win: NSWindow; AFormStyle: TFormStyle);
var
lvl : NSInteger;
begin
if not (AFormStyle in [fsNormal, fsMDIChild, fsMDIForm]) then
begin
lvl := FormStyleToWindowLevel[AFormStyle];
{$ifdef BOOLFIX}
win.setHidesOnDeactivate_(Ord(FormStyleToHideOnDeactivate[AFormStyle]));
{$else}
win.setHidesOnDeactivate(FormStyleToHideOnDeactivate[AFormStyle]);
{$endif}
end
else
begin
lvl := 0;
{$ifdef BOOLFIX}
win.setHidesOnDeactivate_(Ord(false));
{$else}
win.setHidesOnDeactivate(false);
{$endif}
end;
win.setLevel(lvl);
if win.isKindOfClass(TCocoaWindow) then
TCocoaWindow(win).keepWinLevel := lvl;
end;
{ TCocoaWSHintWindow }
class function TCocoaWSHintWindow.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
win: TCocoaPanel;
cnt: TCocoaWindowContent;
R: NSRect;
Form: TCustomForm absolute AWinControl;
cb: TLCLWindowCallback;
const
WinMask = NSBorderlessWindowMask or NSUtilityWindowMask;
begin
win := TCocoaPanel(TCocoaPanel.alloc);
if not Assigned(win) then
begin
Result := 0;
Exit;
end;
R := CreateParamsToNSRect(AParams);
{$ifdef BOOLFIX}
win := TCocoaPanel(win.initWithContentRect_styleMask_backing_defer_(R, WinMask, NSBackingStoreBuffered, Ord(False)));
{$else}
win := TCocoaPanel(win.initWithContentRect_styleMask_backing_defer(R, WinMask, NSBackingStoreBuffered, False));
{$endif}
win.enableCursorRects;
win.setLevel(HintWindowLevel);
win.setDelegate(win);
{$ifdef BOOLFIX}
win.setHasShadow_(Ord(true));
{$else}
win.setHasShadow(true);
{$endif}
if AWinControl.Perform(WM_NCHITTEST, 0, 0)=HTTRANSPARENT then
{$ifdef BOOLFIX}
win.setIgnoresMouseEvents_(Ord(True))
{$else}
win.setIgnoresMouseEvents(True)
{$endif}
else
{$ifdef BOOLFIX}
win.setAcceptsMouseMovedEvents_(Ord(True));
{$else}
win.setAcceptsMouseMovedEvents(True);
{$endif}
R.origin.x := 0;
R.origin.y := 0;
cnt := TCocoaWindowContent.alloc.initWithFrame(R);
cb := TLCLWindowCallback.Create(cnt, AWinControl, cnt);
cb.window := win;
cnt.callback := cb;
cnt.preventKeyOnShow := true;
TCocoaPanel(win).callback := cb;
win.setContentView(cnt);
Result := TLCLIntfHandle(cnt);
end;
class procedure TCocoaWSHintWindow.SetText(const AWinControl: TWinControl;
const AText: String);
begin
TCocoaWSCustomForm.SetText(AWinControl, AText);
//todo: this is a workaround. For some reason, when moving a hint window
// from one control to another (of the same type), the contents
// of the hint window is not invalidated.
//
// Need to figure out why this is happening and resolve at the proper place.
// In the mean time - invalidating contents every time Caption is change
if (AWinControl.HandleAllocated) then
{$ifdef BOOLFIX}
NSView(AWinControl.Handle).setNeedsDisplay__(Ord(true));
{$else}
NSView(AWinControl.Handle).setNeedsDisplay_(true);
{$endif}
end;
{ TLCLWindowCallback }
function TLCLWindowCallback.CanActivate: Boolean;
begin
Result := Enabled;
end;
constructor TLCLWindowCallback.Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView);
begin
inherited;
IsActivating:=false;
end;
destructor TLCLWindowCallback.Destroy;
begin
if Assigned(window) then window.lclClearCallback;
inherited Destroy;
end;
procedure TLCLWindowCallback.Activate;
var
ACustForm: TCustomForm;
begin
if not IsActivating then
begin
IsActivating:=True;
ACustForm := Target as TCustomForm;
if (csDesigning in ACustForm.ComponentState)
or (Assigned(ACustForm.Menu) and (csDesigning in ACustForm.Menu.ComponentState))
then Exit;
if (ACustForm.Menu <> nil) and
(ACustForm.Menu.HandleAllocated) then
begin
if NSObject(ACustForm.Menu.Handle).isKindOfClass_(TCocoaMenu) then
begin
CocoaWidgetSet.SetMainMenu(ACustForm.Menu.Handle, ACustForm.Menu);
TCocoaMenu(ACustForm.Menu.Handle).attachAppleMenu();
end
else
debugln('Warning: Menu does not have a valid handle.');
end
else
CocoaWidgetSet.SetMainMenu(0, nil);
LCLSendActivateMsg(Target, WA_ACTIVE, false);
LCLSendSetFocusMsg(Target);
// The only way to update Forms.ActiveCustomForm for the main form
// is calling TCustomForm.SetFocusedControl, see bug 31056
ACustForm.SetFocusedControl(ACustForm.ActiveControl);
IsActivating:=False;
if CocoaWidgetSet.isModalSession then
NSView(ACustForm.Handle).window.orderFront(nil);
end;
end;
procedure TLCLWindowCallback.Deactivate;
begin
LCLSendActivateMsg(Target, WA_INACTIVE, false);
LCLSendKillFocusMsg(Target);
end;
procedure TLCLWindowCallback.CloseQuery(var CanClose: Boolean);
var
i: Integer;
begin
// Message results : 0 - do nothing, 1 - destroy window
CanClose := LCLSendCloseQueryMsg(Target) > 0;
// Special code for modal forms, which otherwise would get 0 here and not call Close
if (CocoaWidgetSet.CurModalForm = window) and
(TCustomForm(Target).ModalResult <> mrNone) then
begin
{$IFDEF COCOA_USE_NATIVE_MODAL}
NSApp.stopModal();
{$ENDIF}
CocoaWidgetSet.CurModalForm := nil;
{// Felipe: This code forces focusing another form, its a work around
// for a gdb issue, gdb doesn't start the app properly
//
// At this point the modal form is closed, but the previously open form isn't focused
// Focus the main window if it is visible
if Application.MainForm.Visible then Application.MainForm.SetFocus()
else
begin
// if the mainform is hidden, just choose any visible form
// ToDo: Figure out a better solution
for i := 0 to Screen.FormCount-1 do
if Screen.Forms[i].Visible then
begin
Screen.Forms[i].SetFocus();
Break;
end;
end;}
end;
end;
procedure TLCLWindowCallback.Close;
begin
LCLSendCloseUpMsg(Target);
end;
procedure TLCLWindowCallback.Resize;
begin
boundsDidChange(Owner);
end;
procedure TLCLWindowCallback.Move;
begin
boundsDidChange(Owner);
end;
function TLCLWindowCallback.GetEnabled: Boolean;
begin
Result := Owner.lclIsEnabled;
end;
procedure TLCLWindowCallback.SetEnabled(AValue: Boolean);
begin
Owner.lclSetEnabled(AValue);
end;
function TLCLWindowCallback.AcceptFilesDrag: Boolean;
begin
Result := Assigned(Target) and Assigned(TCustomForm(Target).OnDropFiles);
end;
procedure TLCLWindowCallback.DropFiles(const FileNames: array of string);
begin
if Assigned(Target) then
TCustomForm(Target).IntfDropFiles(FileNames);
end;
{ TCocoaWSScrollingWinControl}
class function TCocoaWSScrollingWinControl.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
var
scrollcon: TCocoaScrollView;
docview: TCocoaCustomControl;
lcl : TLCLCommonCallback;
begin
docview := TCocoaCustomControl.alloc.lclInitWithCreateParams(AParams);
scrollcon:=EmbedInScrollView(docView);
scrollcon.setBackgroundColor(NSColor.windowBackgroundColor);
scrollcon.setAutohidesScrollers(True);
scrollcon.setHasHorizontalScroller(True);
scrollcon.setHasVerticalScroller(True);
scrollcon.isCustomRange := true;
lcl := TLCLCommonCallback.Create(docview, AWinControl, scrollcon);
lcl.BlockCocoaUpDown := true;
docview.callback := lcl;
docview.setAutoresizingMask(NSViewWidthSizable or NSViewHeightSizable);
scrollcon.callback := lcl;
scrollcon.setDocumentView(docview);
ScrollViewSetBorderStyle(scrollcon, TScrollingWinControl(AWincontrol).BorderStyle);
Result := TLCLIntfHandle(scrollcon);
end;
class procedure TCocoaWSScrollingWinControl.SetBorderStyle(
const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
if not Assigned(AWinControl) or not AWincontrol.HandleAllocated then Exit;
ScrollViewSetBorderStyle( NSScrollView(AWinControl.Handle), ABorderStyle);
end;
{ TCocoaWSCustomForm }
procedure ArrangeTabOrder(const AWinControl: TWinControl);
var
lList: TFPList;
prevControl, curControl: TWinControl;
lPrevView, lCurView: NSView;
i: Integer;
begin
lList := TFPList.Create;
try
AWinControl.GetTabOrderList(lList);
if lList.Count>0 then
begin
prevControl := TWinControl(lList.Items[lList.Count-1]);
lPrevView := GetNSObjectView(NSObject(prevControl.Handle));
for i := 0 to lList.Count-1 do
begin
curControl := TWinControl(lList.Items[i]);
lCurView := GetNSObjectView(NSObject(curControl.Handle));
if (lCurView <> nil) and (lPrevView <> nil) then
lPrevView.setNextKeyView(lCurView);
lPrevView := lCurView;
end;
end;
finally
lList.Free;
end;
end;
class function TCocoaWSCustomForm.GetStyleMaskFor(
ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons): NSUInteger;
begin
case ABorderStyle of
bsSizeable, bsSizeToolWin:
Result := NSTitledWindowMask or NSResizableWindowMask;
bsSingle, bsDialog, bsToolWindow:
Result := NSTitledWindowMask;
else
Result := NSBorderlessWindowMask;
end;
if biSystemMenu in ABorderIcons then
begin
Result := Result or NSClosableWindowMask;
if biMinimize in ABorderIcons then
Result := Result or NSMiniaturizableWindowMask;
end;
end;
class procedure TCocoaWSCustomForm.UpdateWindowIcons(AWindow: NSWindow;
ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons);
procedure SetWindowButtonState(AButton: NSWindowButton; AEnabled, AVisible: Boolean);
var
Btn: NSButton;
begin
Btn := AWindow.standardWindowButton(AButton);
if Assigned(Btn) then
begin
{$ifdef BOOLFIX}
Btn.setHidden_(Ord(not AVisible));
Btn.setEnabled_(Ord(AEnabled));
{$else}
Btn.setHidden(not AVisible);
Btn.setEnabled(AEnabled);
{$endif}
end;
end;
begin
SetWindowButtonState(NSWindowMiniaturizeButton, biMinimize in ABorderIcons, (ABorderStyle in [bsSingle, bsSizeable]) and (biSystemMenu in ABorderIcons));
SetWindowButtonState(NSWindowZoomButton, (biMaximize in ABorderIcons) and (ABorderStyle in [bsSizeable, bsSizeToolWin]), (ABorderStyle in [bsSingle, bsSizeable]) and (biSystemMenu in ABorderIcons));
SetWindowButtonState(NSWindowCloseButton, True, (ABorderStyle <> bsNone) and (biSystemMenu in ABorderIcons));
end;
class procedure TCocoaWSCustomForm.UpdateWindowMask(AWindow: NSWindow;
ABorderStyle: TFormBorderStyle; ABorderIcons: TBorderIcons);
var
StyleMask: NSUInteger;
begin
StyleMask := GetStyleMaskFor(ABorderStyle, ABorderIcons);
AWindow.setStyleMask(StyleMask);
UpdateWindowIcons(AWindow, ABorderStyle, ABorderIcons);
end;
class function TCocoaWSCustomForm.GetWindowFromHandle(const ACustomForm: TCustomForm): TCocoaWindow;
begin
Result := nil;
if not ACustomForm.HandleAllocated then Exit;
Result := TCocoaWindow(TCocoaWindowContent(ACustomForm.Handle).lclOwnWindow);
end;
class function TCocoaWSCustomForm.GetWindowContentFromHandle(const ACustomForm: TCustomForm): TCocoaWindowContent;
begin
Result := nil;
if not ACustomForm.HandleAllocated then Exit;
Result := TCocoaWindowContent(ACustomForm.Handle);
end;
// Some projects that use the LCL need to override this
class function TCocoaWSCustomForm.AllocWindowHandle: TCocoaWindow;
begin
Result := TCocoaWindow(TCocoaWindow.alloc);
end;
class function TCocoaWSCustomForm.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Form: TCustomForm absolute AWinControl;
win: TCocoaWindow;
cnt: TCocoaWindowContent;
ns: NSString;
R: NSRect;
lDestView: NSView;
ds: TCocoaDesignOverlay;
cb: TLCLWindowCallback;
begin
//todo: create TCocoaWindow or TCocoaPanel depending on the border style
// if parent is specified neither Window nor Panel needs to be created
// the only thing that needs to be created is Content
R := CreateParamsToNSRect(AParams);
cnt := TCocoaWindowContent.alloc.initWithFrame(R);
cb := TLCLWindowCallback.Create(cnt, AWinControl, cnt);
cnt.callback := cb;
if (AParams.Style and WS_CHILD) = 0 then
begin
win := AllocWindowHandle;
if not Assigned(win) then
begin
Result := 0;
Exit;
end;
{$ifdef BOOLFIX}
win := TCocoaWindow(win.initWithContentRect_styleMask_backing_defer_(R,
GetStyleMaskFor(GetDesigningBorderStyle(Form), Form.BorderIcons), NSBackingStoreBuffered, Ord(False)));
{$else}
win := TCocoaWindow(win.initWithContentRect_styleMask_backing_defer(R,
GetStyleMaskFor(GetDesigningBorderStyle(Form), Form.BorderIcons), NSBackingStoreBuffered, False));
{$endif}
UpdateWindowIcons(win, GetDesigningBorderStyle(Form), Form.BorderIcons);
// For safety, it is better to not apply any setLevel & similar if the form is just a standard style
// see issue http://bugs.freepascal.org/view.php?id=28473
if not (csDesigning in AWinControl.ComponentState) then
WindowSetFormStyle(win, Form.FormStyle);
win.enableCursorRects;
TCocoaWindow(win).callback := cb;
cb.window := win;
win.setDelegate(win);
ns := NSStringUtf8(AWinControl.Caption);
win.setTitle(ns);
ns.release;
{$ifdef BOOLFIX}
win.setReleasedWhenClosed_(Ord(False)); // do not release automatically
win.setAcceptsMouseMovedEvents_(Ord(True));
{$else}
win.setReleasedWhenClosed(False); // do not release automatically
win.setAcceptsMouseMovedEvents(True);
{$endif}
if win.respondsToSelector(ObjCSelector('setTabbingMode:')) then
win.setTabbingMode(NSWindowTabbingModeDisallowed);
if AWinControl.Perform(WM_NCHITTEST, 0, 0)=HTTRANSPARENT then
begin
{$ifdef BOOLFIX}
win.setIgnoresMouseEvents_(Ord(True));
{$else}
win.setIgnoresMouseEvents(True);
{$endif}
end;
cnt.callback := TCocoaWindow(win).callback;
cnt.callback.IsOpaque:=true;
win.setContentView(cnt);
// Don't call addChildWindow_ordered here because this function can cause
// events to arrive for this window, creating a second call to TCocoaWSCustomForm.CreateHandle
// while the first didn't finish yet, instead delay the call
cnt.popup_parent := AParams.WndParent;
// support for drag & drop
win.registerForDraggedTypes(NSArray.arrayWithObjects_count(@NSFilenamesPboardType, 1));
if IsFormDesign(AWinControl) then begin
ds:=(TCocoaDesignOverlay.alloc).initWithFrame(cnt.frame);
ds.callback := cnt.callback;
ds.setAutoresizingMask(NSViewWidthSizable or NSViewHeightSizable);
cnt.addSubview_positioned_relativeTo(ds, NSWindowAbove, nil);
cnt.overlay := ds;
end;
end
else
begin
cnt.callback := TLCLCommonCallback.Create(cnt, AWinControl);
if AParams.WndParent <> 0 then
begin
lDestView := GetNSObjectView(NSObject(AParams.WndParent));
lDestView.addSubView(cnt);
if cnt.window <> nil then
cnt.window.setAcceptsMouseMovedEvents(True);
cnt.callback.IsOpaque:=true;
// todo: We have to find a way to remove the following notifications save before cnt will be released
// NSNotificationCenter.defaultCenter.addObserver_selector_name_object(cnt, objcselector('didBecomeKeyNotification:'), NSWindowDidBecomeKeyNotification, cnt.window);
// NSNotificationCenter.defaultCenter.addObserver_selector_name_object(cnt, objcselector('didResignKeyNotification:'), NSWindowDidResignKeyNotification, cnt.window);
end;
end;
Result := TLCLIntfHandle(cnt);
end;
class procedure TCocoaWSCustomForm.DestroyHandle(const AWinControl: TWinControl
);
var
win : NSWindow;
begin
if not AWinControl.HandleAllocated then
Exit;
win := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if Assigned(win) then
begin
// this is needed for macOS 10.6.
// if window has been created with a parent (on ShowModal)
// it should be removed from "parentWindow"
if Assigned(win.parentWindow) then
win.parentWindow.removeChildWindow(win);
win.close;
end;
TCocoaWSWinControl.DestroyHandle(AWinControl);
end;
class function TCocoaWSCustomForm.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
var
win : NSWindow;
begin
Result := AWinControl.HandleAllocated;
if Result then
begin
win := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if not Assigned(win) then
AText := NSStringToString(TCocoaWindowContent(AWinControl.Handle).stringValue)
else
AText := NSStringToString(win.title);
end;
end;
class function TCocoaWSCustomForm.GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean;
var
win : NSWindow;
begin
Result := AWinControl.HandleAllocated;
if Result then
begin
win := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if Assigned(win) then
ALength := NSWindow(AWinControl.Handle).title.length
else
begin
ALength := TCocoaWindowContent(AWinControl.Handle).stringValue.length
end;
end;
end;
class procedure TCocoaWSCustomForm.SetText(const AWinControl: TWinControl; const AText: String);
var
ns: NSString;
win : NSWindow;
begin
if not AWinControl.HandleAllocated then
Exit;
win := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
ns := NSStringUtf8(AText);
if Assigned(win) then
NSwindow(win).setTitle(ns)
else
TCocoaWindowContent(AWinControl.Handle).setStringValue(ns);
ns.release;
end;
class procedure TCocoaWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
begin
CocoaWidgetSet.EndModal(NSView(ACustomForm.Handle).window);
end;
class procedure TCocoaWSCustomForm.ShowModal(const ACustomForm: TCustomForm);
var
lWinContent: TCocoaWindowContent;
win: TCocoaWindow;
{$ifdef COCOA_USE_NATIVE_MODAL}
win: TCocoaWindow;
{$endif}
fullscreen: Boolean;
begin
// Another possible implementation is to have modal started in ShowHide with (fsModal in AForm.FormState)
// Handle PopupParent
lWinContent := GetWindowContentFromHandle(ACustomForm);
fullscreen := ACustomForm.WindowState = wsFullScreen;
if (not fullscreen) and (lWinContent.window.isKindOfClass(TCocoaWindow)) then
fullscreen := TCocoaWindow(lWinContent.window).lclIsFullScreen;
// A window opening in full screen doesn't like to be added as someones popup
// Thus resolvePopupParent should only be used for non full-screens forms
//if (lWinContent <> nil) and (not fullscreen) then
//lWinContent.resolvePopupParent();
CocoaWidgetSet.CurModalForm := lWinContent.lclOwnWindow;
// LCL initialization code would cause the custom form to be disabled
// (due to the fact, ShowModal() has not been called yet, and a previous form
// might be disabled at the time.
// ...
// The fact there's a single global variable is used to indicate, that there's
// a modal form (neglecting the need for stack of modal forms)
// makes a developer want to rewrite the whole approach for something more
// Cocoa and good-practicies friendly.
// ...
// At this point of time, we simply force enabling of the new modal form
// (which is happening in LCL code, but at the wrong time)
NSObject(ACustomForm.Handle).lclSetEnabled(true);
// Another possible implementation is using a session, but this requires
// disabling the other windows ourselves
win := TCocoaWSCustomForm.GetWindowFromHandle(ACustomForm);
if win = nil then Exit;
CocoaWidgetSet.StartModal(NSView(ACustomForm.Handle).window, Assigned(ACustomForm.Menu));
// Another possible implementation is using runModalForWindow
{$ifdef COCOA_USE_NATIVE_MODAL}
win := TCocoaWSCustomForm.GetWindowFromHandle(ACustomForm);
if win = nil then Exit;
NSApp.runModalForWindow(win);
{$endif}
end;
// If ShowModal will not be fully blocking in the future this can be removed
class procedure TCocoaWSCustomForm.SetModalResult(const ACustomForm: TCustomForm;
ANewValue: TModalResult);
begin
if (CocoaWidgetSet.CurModalForm = NSView(ACustomForm.Handle).window) and (ANewValue <> 0) then
CloseModal(ACustomForm);
end;
class procedure TCocoaWSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; const AlphaBlend: Boolean; const Alpha: Byte);
var
win : NSWindow;
begin
if ACustomForm.HandleAllocated then
begin
win := TCocoaWindowContent(ACustomForm.Handle).lclOwnWindow;
if not Assigned(win) then
Exit;
if AlphaBlend then
win.setAlphaValue(Alpha / 255)
else
win.setAlphaValue(1);
end;
end;
class procedure TCocoaWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
const ABorderIcons: TBorderIcons);
var
win : NSWindow;
begin
if AForm.HandleAllocated then
begin
win := NSWindow(TCocoaWindowContent(AForm.Handle).lclOwnWindow);
if Assigned(win) then
UpdateWindowMask(win, GetDesigningBorderStyle(AForm), ABorderIcons);
end;
end;
class procedure TCocoaWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
const AFormBorderStyle: TFormBorderStyle);
var
win : NSWindow;
begin
if AForm.HandleAllocated then
begin
win := NSWindow(TCocoaWindowContent(AForm.Handle).lclOwnWindow);
if Assigned(win) then
UpdateWindowMask(win, AFormBorderStyle, AForm.BorderIcons);
end;
end;
class procedure TCocoaWSCustomForm.SetFormStyle(const AForm: TCustomform;
const AFormStyle, AOldFormStyle: TFormStyle);
var
win : NSWindow;
begin
if AForm.HandleAllocated and not (csDesigning in AForm.ComponentState) then
begin
win := TCocoaWindowContent(AForm.Handle).lclOwnWindow;
WindowSetFormStyle(win, AFormStyle);
end;
end;
class procedure TCocoaWSCustomForm.SetRealPopupParent(
const ACustomForm: TCustomForm; const APopupParent: TCustomForm);
var
win : NSWindow;
begin
if not ACustomForm.HandleAllocated then Exit;
win := TCocoaWindowContent(ACustomForm.Handle).lclOwnWindow;
if Assigned(win.parentWindow) then
win.parentWindow.removeChildWindow(win);
if Assigned(APopupParent) then begin
writeln('SetRealPopupParent ',APopupParent.ClassName);
NSWindow( NSView(APopupParent.Handle).window).addChildWindow_ordered(win, NSWindowAbove);
end;
end;
class procedure TCocoaWSCustomForm.ShowHide(const AWinControl: TWinControl);
var
lShow : Boolean;
w : NSWindow;
begin
lShow := AWinControl.HandleObjectShouldBeVisible;
// TCustomForm class of LCL doesn't do anything specific about first time showing
// of wsFullScreen window. Thus it should be taken care of in WS size
if lShow and (TCustomForm(AWinControl).WindowState = wsFullScreen) then
begin
w := NSView(AWinControl.Handle).window;
if Assigned(w) and (w.isKindOfClass(TCocoaWindow)) then
TCocoaWindow(w).lclSwitchFullScreen(true);
end
else
begin
if not lShow then
begin
// macOS 10.6. If a window with a parent window is hidden, then parent is also hidden.
// Detaching from the parent first!
w := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if Assigned(w) and Assigned(w.parentWindow) then
w.parentWindow.removeChildWindow(w);
end;
TCocoaWSWinControl.ShowHide(AWinControl);
end;
if (lShow) then
ArrangeTabOrder(AWinControl);
end;
class function TCocoaWSCustomForm.GetClientBounds(
const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := False;
if not AWinControl.HandleAllocated then Exit;
ARect := NSObject(AWinControl.Handle).lclClientFrame;
Result := True;
end;
class function TCocoaWSCustomForm.GetClientRect(const AWincontrol: TWinControl;
var ARect: TRect): Boolean;
var
x, y: Integer;
begin
Result := AWinControl.HandleAllocated;
if not Result then Exit;
ARect := NSObject(AWinControl.Handle).lclClientFrame;
x := 0;
y := 0;
NSObject(AWinControl.Handle).lclLocalToScreen(x, y);
MoveRect(ARect, x, y);
end;
class procedure TCocoaWSCustomForm.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
begin
if AWinControl.HandleAllocated then
begin
//debugln('TCocoaWSCustomForm.SetBounds: '+AWinControl.Name+'Bounds='+dbgs(Bounds(ALeft, ATop, AWidth, AHeight)));
NSObject(AWinControl.Handle).lclSetFrame(Bounds(ALeft, ATop, AWidth, AHeight));
TCocoaWindowContent(AwinControl.Handle).callback.boundsDidChange(NSObject(AWinControl.Handle));
end;
end;
function HWNDToForm(AFormHandle: HWND): TCustomForm;
var
obj : TObject;
begin
obj := HWNDToTargetObject(AFormHandle);
if Assigned(obj) and (obj is TCustomForm)
then Result := TCustomForm(obj)
else Result := nil;
end;
end.