mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-06 17:18:19 +02:00
995 lines
31 KiB
ObjectPascal
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.
|