customdrawnws: Advances the Cocoa backend

git-svn-id: trunk@33402 -

.gitattributes

@@ -5395,20 +5395,24 @@ lcl/interfaces/cocoa/cocoawsstdctrls.pp svneol=native#text/plain
 lcl/interfaces/cocoa/interfaces.pas svneol=native#text/plain
 lcl/interfaces/customdrawn/Makefile svneol=native#text/plain
 lcl/interfaces/customdrawn/Makefile.fpc svneol=native#text/plain
-lcl/interfaces/customdrawn/alllclintfunits.pas svneol=native#text/plain
+lcl/interfaces/customdrawn/alllclintfunits.pas svneol=native#text/pascal
+lcl/interfaces/customdrawn/cocoagdiobjects.pas svneol=native#text/pascal
+lcl/interfaces/customdrawn/cocoaprivate.pas svneol=native#text/pascal
+lcl/interfaces/customdrawn/cocoautils.pas svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawndefines.inc svneol=native#text/pascal
-lcl/interfaces/customdrawn/customdrawnint.pas svneol=native#text/plain
+lcl/interfaces/customdrawn/customdrawnint.pas svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawnobject.inc svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawnobject_cocoa.inc svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawnobject_win.inc svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawnwscontrols.pp svneol=native#text/plain
-lcl/interfaces/customdrawn/customdrawnwscontrols_win.inc svneol=native#text/plain
-lcl/interfaces/customdrawn/customdrawnwsfactory.pas svneol=native#text/plain
+lcl/interfaces/customdrawn/customdrawnwscontrols_win.inc svneol=native#text/pascal
+lcl/interfaces/customdrawn/customdrawnwsfactory.pas svneol=native#text/pascal
 lcl/interfaces/customdrawn/customdrawnwsforms.pp svneol=native#text/plain
-lcl/interfaces/customdrawn/customdrawnwsforms_win.inc svneol=native#text/plain
-lcl/interfaces/customdrawn/interfaces.pas svneol=native#text/plain
+lcl/interfaces/customdrawn/customdrawnwsforms_cocoa.inc svneol=native#text/pascal
+lcl/interfaces/customdrawn/customdrawnwsforms_win.inc svneol=native#text/pascal
+lcl/interfaces/customdrawn/interfaces.pas svneol=native#text/pascal
 lcl/interfaces/customdrawn/wincallback.inc svneol=native#text/pascal
-lcl/interfaces/customdrawn/winproc.pas svneol=native#text/plain
+lcl/interfaces/customdrawn/winproc.pas svneol=native#text/pascal
 lcl/interfaces/fpgui/Makefile.compiled svneol=native#text/plain
 lcl/interfaces/fpgui/Makefile.fpc svneol=native#text/plain
 lcl/interfaces/fpgui/README.txt svneol=native#text/plain

lcl/interfaces/customdrawn/cocoaprivate.pas

@@ -0,0 +1,708 @@
+unit cocoaprivate;
+
+{$mode objfpc}{$H+}
+{$modeswitch objectivec1}
+
+interface
+
+uses
+  // rtl+ftl
+  Types, Classes, SysUtils,
+  CGGeometry,
+  // Libs
+  MacOSAll, CocoaAll, CocoaUtils, CocoaGDIObjects,
+  //
+  Controls, LCLMessageGlue, WSControls, LCLType;
+
+type
+  { LCLObjectExtension }
+
+  LCLObjectExtension = objccategory(NSObject)
+    function lclIsEnabled: Boolean; message 'lclIsEnabled';
+    procedure lclSetEnabled(AEnabled: Boolean); message 'lclSetEnabled:';
+    function lclIsVisible: Boolean; message 'lclIsVisible';
+
+    procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:';
+    procedure lclInvalidate; message 'lclInvalidate';
+    procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::';
+    procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::';
+    function lclParent: id; message 'lclParent';
+    function lclFrame: TRect; message 'lclFrame';
+    procedure lclSetFrame(const r: TRect); message 'lclSetFrame:';
+    function lclClientFrame: TRect; message 'lclClientFrame';
+  end;
+
+  { LCLViewExtension }
+
+  LCLViewExtension = objccategory(NSView)
+    function lclIsVisible: Boolean; message 'lclIsVisible'; reintroduce;
+    procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
+    procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
+    procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::'; reintroduce;
+    function lclParent: id; message 'lclParent'; reintroduce;
+    function lclFrame: TRect; message 'lclFrame'; reintroduce;
+    procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce;
+    function lclClientFrame: TRect; message 'lclClientFrame'; reintroduce;
+  end;
+
+  { LCLControlExtension }
+
+  LCLControlExtension = objccategory(NSControl)
+    function lclIsEnabled: Boolean; message 'lclIsEnabled'; reintroduce;
+    procedure lclSetEnabled(AEnabled: Boolean); message 'lclSetEnabled:'; reintroduce;
+  end;
+
+  { LCLWindowExtension }
+
+  LCLWindowExtension = objccategory(NSWindow)
+    function lclIsVisible: Boolean; message 'lclIsVisible'; reintroduce;
+    procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
+    procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
+    procedure lclLocalToScreen(var X,Y: Integer); message 'lclLocalToScreen::'; reintroduce;
+    function lclFrame: TRect; message 'lclFrame'; reintroduce;
+    procedure lclSetFrame(const r: TRect); message 'lclSetFrame:'; reintroduce;
+    function lclClientFrame: TRect; message 'lclClientFrame'; reintroduce;
+  end;
+
+  { TCommonCallback }
+
+  TCommonCallback = class(TObject)
+  public
+    Owner : NSObject;
+    constructor Create(AOwner: NSObject);
+    procedure MouseDown(x,y: Integer); virtual; abstract;
+    procedure MouseUp(x,y: Integer); virtual; abstract;
+    procedure MouseClick(ClickCount: Integer); virtual; abstract;
+    procedure MouseMove(x,y: Integer); virtual; abstract;
+    procedure Draw(ctx: NSGraphicsContext; const bounds, dirty: NSRect); virtual; abstract;
+  end;
+
+  { TWindowCallback }
+
+  TWindowCallback = class(TObject)
+  public
+    Owner : NSWindow;
+    constructor Create(AOwner: NSWindow);
+    procedure Activate; virtual; abstract;
+    procedure Deactivate; virtual; abstract;
+    procedure CloseQuery(var CanClose: Boolean); virtual; abstract;
+    procedure Close; virtual; abstract;
+    procedure Resize; virtual; abstract;
+  end;
+
+  { TCocoaWindow }
+
+  TCocoaWindow = objcclass(NSWindow, 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:';
+  public
+    callback      : TCommonCallback;
+    wincallback   : TWindowCallback;
+    function acceptsFirstResponder: Boolean; override;
+    procedure mouseUp(event: NSEvent); override;
+    procedure mouseDown(event: NSEvent); override;
+    procedure mouseDragged(event: NSEvent); override;
+    procedure mouseEntered(event: NSEvent); override;
+    procedure mouseExited(event: NSEvent); override;
+    procedure mouseMoved(event: NSEvent); override;
+  end;
+
+  { TCocoaCustomControl }
+
+  TCocoaCustomControl = objcclass(NSControl)
+    callback  : TCommonCallback;
+    procedure drawRect(dirtyRect: NSRect); override;
+  end;
+
+  TLCLWindowCallback=class(TWindowCallback)
+  public
+    Target  : TControl;
+    constructor Create(AOwner: NSWindow; ATarget: TControl);
+    procedure Activate; override;
+    procedure Deactivate; override;
+    procedure CloseQuery(var CanClose: Boolean); override;
+    procedure Close; override;
+    procedure Resize; override;
+  end;
+
+  { TLCLCommonCallback }
+
+  TLCLCommonCallback = class(TCommonCallback)
+  public
+    Target  : TControl;
+    Context : TCocoaContext;
+    constructor Create(AOwner: NSObject; ATarget: TControl);
+    destructor Destroy; override;
+    procedure MouseDown(x,y: Integer); override;
+    procedure MouseUp(x,y: Integer); override;
+    procedure MouseClick(clickCount: Integer); override;
+    procedure MouseMove(x,y: Integer); override;
+    procedure Draw(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); override;
+  end;
+
+  { TCocoaWSWinControl }
+
+  TCocoaWSWinControl=class(TWSWinControl)
+  published
+    class function CreateHandle(const AWinControl: TWinControl;
+      const AParams: TCreateParams): TLCLIntfHandle; override;
+    class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
+    class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
+    class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; override;
+
+    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;
+
+
+  { TCocoaWSCustomControl }
+
+  TCocoaWSCustomControl=class(TWSCustomControl)
+  published
+    class function CreateHandle(const AWinControl: TWinControl;
+      const AParams: TCreateParams): TLCLIntfHandle; override;
+  end;
+
+  LCLWSViewExtension = objccategory(NSView)
+    function lclInitWithCreateParams(const AParams: TCreateParams): id; message 'lclInitWithCreateParams:';
+  end;
+
+function AllocCustomControl(const AWinControl: TWinControl): TCocoaCustomControl;
+procedure SetViewDefaults(AView: NSView);
+
+implementation
+
+uses customdrawnwsforms;
+
+{ TCocoaWindow }
+
+function TCocoaWindow.windowShouldClose(sender: id): LongBool;
+var
+  canClose : Boolean;
+begin
+  canClose:=true;
+  wincallback.CloseQuery(canClose);
+  Result:=canClose;
+end;
+
+procedure TCocoaWindow.windowWillClose(notification: NSNotification);
+begin
+  wincallback.Close;
+end;
+
+procedure TCocoaWindow.windowDidBecomeKey(notification: NSNotification);
+begin
+  wincallback.Activate;
+end;
+
+procedure TCocoaWindow.windowDidResignKey(notification: NSNotification);
+begin
+  wincallback.Deactivate;
+end;
+
+procedure TCocoaWindow.windowDidResize(notification: NSNotification);
+begin
+  wincallback.Resize;
+end;
+
+function TCocoaWindow.acceptsFirstResponder: Boolean;
+begin
+  Result:=true;
+end;
+
+procedure TCocoaWindow.mouseUp(event: NSEvent);
+var
+  mp : NSPoint;
+begin
+  mp:=event.locationInWindow;
+  mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
+  callback.MouseUp(round(mp.x), round(mp.y));
+  inherited mouseUp(event);
+end;
+
+procedure TCocoaWindow.mouseDown(event: NSEvent);
+var
+  mp : NSPoint;
+begin
+  mp:=event.locationInWindow;
+  mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
+  callback.MouseDown(round(mp.x), round(mp.y));
+  inherited mouseDown(event);
+end;
+
+procedure TCocoaWindow.mouseDragged(event: NSEvent);
+var
+  mp : NSPoint;
+begin
+  mp:=event.locationInWindow;
+  mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
+  callback.MouseMove(round(mp.x), round(mp.y));
+  inherited mouseMoved(event);
+end;
+
+procedure TCocoaWindow.mouseMoved(event: NSEvent);
+var
+  mp : NSPoint;
+begin
+  mp:=event.locationInWindow;
+  mp.y:=NSView(event.window.contentView).bounds.size.height-mp.y;
+  callback.MouseMove(round(mp.x), round(mp.y));
+  inherited mouseMoved(event);
+end;
+
+procedure TCocoaWindow.mouseEntered(event: NSEvent);
+begin
+  inherited mouseEntered(event);
+end;
+
+procedure TCocoaWindow.mouseExited(event: NSEvent);
+begin
+  inherited mouseExited(event);
+end;
+
+{ TCommonCallback }
+
+constructor TCommonCallback.Create(AOwner: NSObject);
+begin
+  Owner:=AOwner;
+end;
+
+{ TWindowCallback }
+
+constructor TWindowCallback.Create(AOwner: NSWindow);
+begin
+  Owner:=AOwner;
+end;
+
+{ TCocoaCustomControl }
+
+procedure TCocoaCustomControl.drawRect(dirtyRect:NSRect);
+begin
+  inherited drawRect(dirtyRect);
+  callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
+end;
+
+{ LCLObjectExtension }
+
+function LCLObjectExtension.lclIsEnabled:Boolean;
+begin
+  Result:=False;
+end;
+
+procedure LCLObjectExtension.lclSetEnabled(AEnabled:Boolean);
+begin
+end;
+
+function LCLObjectExtension.lclIsVisible:Boolean;
+begin
+  Result:=False;
+end;
+
+procedure LCLObjectExtension.lclInvalidateRect(const r:TRect);
+begin
+
+end;
+
+procedure LCLObjectExtension.lclInvalidate;
+begin
+
+end;
+
+procedure LCLObjectExtension.lclRelativePos(var Left,Top:Integer);
+begin
+
+end;
+
+procedure LCLObjectExtension.lclLocalToScreen(var X,Y:Integer);
+begin
+
+end;
+
+function LCLObjectExtension.lclParent:id;
+begin
+  Result:=nil;
+end;
+
+function LCLObjectExtension.lclFrame:TRect;
+begin
+  FillChar(Result, sizeof(Result), 0);
+end;
+
+procedure LCLObjectExtension.lclSetFrame(const r:TRect);
+begin
+
+end;
+
+function LCLObjectExtension.lclClientFrame:TRect;
+begin
+  FillChar(Result, sizeof(Result), 0);
+end;
+
+{ LCLControlExtension }
+
+function RectToViewCoord(view: NSView; const r: TRect): NSRect;
+var
+  b: NSRect;
+begin
+  if not Assigned(view) then Exit;
+  b:=view.bounds;
+  Result.origin.x:=r.Left;
+  Result.origin.y:=b.size.height-r.Top;
+  Result.size.width:=r.Right-r.Left;
+  Result.size.height:=r.Bottom-r.Top;
+end;
+
+function LCLControlExtension.lclIsEnabled:Boolean;
+begin
+  Result:=IsEnabled;
+end;
+
+procedure LCLControlExtension.lclSetEnabled(AEnabled:Boolean);
+begin
+  SetEnabled(AEnabled);
+end;
+
+function LCLViewExtension.lclIsVisible:Boolean;
+begin
+  Result:=not isHidden;
+end;
+
+procedure LCLViewExtension.lclInvalidateRect(const r:TRect);
+begin
+  setNeedsDisplayInRect(RectToViewCoord(Self, r));
+end;
+
+procedure LCLViewExtension.lclInvalidate;
+begin
+  setNeedsDisplay_(True);
+end;
+
+procedure LCLViewExtension.lclLocalToScreen(var X,Y:Integer);
+begin
+
+end;
+
+function LCLViewExtension.lclParent:id;
+begin
+  Result:=superView;
+end;
+
+function LCLViewExtension.lclFrame: TRect;
+var
+  v : NSView;
+begin
+  v:=superview;
+  if Assigned(v)
+    then NSToLCLRect(frame, v.frame.size.height, Result)
+    else NSToLCLRect(frame, Result);
+end;
+
+procedure LCLViewExtension.lclSetFrame(const r:TRect);
+var
+  ns : NSRect;
+begin
+  if Assigned(superview)
+    then LCLToNSRect(r, superview.frame.size.height, ns)
+    else LCLToNSRect(r, ns);
+  setFrame(ns);
+end;
+
+function LCLViewExtension.lclClientFrame:TRect;
+var
+  r: NSRect;
+begin
+  r:=bounds;
+  Result.Left:=0;
+  Result.Top:=0;
+  Result.Right:=Round(r.size.width);
+  Result.Bottom:=Round(r.size.height);
+end;
+
+{ LCLWindowExtension }
+
+function LCLWindowExtension.lclIsVisible:Boolean;
+begin
+  Result:=isVisible;
+end;
+
+procedure LCLWindowExtension.lclInvalidateRect(const r:TRect);
+begin
+  contentView.lclInvalidateRect(r);
+end;
+
+procedure LCLWindowExtension.lclInvalidate;
+begin
+  contentView.lclInvalidate;
+end;
+
+procedure LCLWindowExtension.lclLocalToScreen(var X,Y:Integer);
+var
+  f   : NSRect;
+begin
+  if Assigned(screen) then begin
+    f:=frame;
+    x:=Round(f.origin.x+x);
+    y:=Round(screen.frame.size.height-f.size.height-f.origin.y);
+  end;
+end;
+
+function LCLWindowExtension.lclFrame:TRect;
+begin
+  if Assigned(screen)
+    then NSToLCLRect(frame, screen.frame.size.height, Result)
+    else NSToLCLRect(frame, Result);
+end;
+
+procedure LCLWindowExtension.lclSetFrame(const r:TRect);
+var
+  ns : NSREct;
+begin
+  if Assigned(screen)
+    then LCLToNSRect(r, screen.frame.size.height, ns)
+    else LCLToNSRect(r, ns);
+  setFrame_display(ns, isVisible);
+end;
+
+function LCLWindowExtension.lclClientFrame:TRect;
+var
+  wr  : NSRect;
+  b   : CGGeometry.CGRect;
+begin
+  wr:=frame;
+  b:=contentView.frame;
+  Result.Left:=Round(b.origin.x);
+  Result.Top:=Round(wr.size.height-b.origin.y);
+  Result.Right:=Round(b.origin.x+b.size.width);
+  Result.Bottom:=Round(Result.Top+b.size.height);
+end;
+
+{ TLCLWindowCallback }
+
+constructor TLCLWindowCallback.Create(AOwner: NSWindow; ATarget: TControl);
+begin
+  inherited Create(AOwner);
+  Target:=ATarget;
+end;
+
+procedure TLCLWindowCallback.Activate;
+begin
+  LCLSendActivateMsg(Target, True, false);
+end;
+
+procedure TLCLWindowCallback.Deactivate;
+begin
+  LCLSendDeactivateStartMsg(Target);
+end;
+
+procedure TLCLWindowCallback.CloseQuery(var CanClose: Boolean);
+begin
+  // Message results : 0 - do nothing, 1 - destroy window
+  CanClose:=LCLSendCloseQueryMsg(Target)>0;
+end;
+
+procedure TLCLWindowCallback.Close;
+begin
+  LCLSendCloseUpMsg(Target);
+end;
+
+procedure TLCLWindowCallback.Resize;
+var
+  sz  : NSSize;
+  r   : TRect;
+begin
+  sz := Owner.frame.size;
+  TCDWSCustomForm.GetClientBounds(TWinControl(Target), r);
+  if Assigned(Target) then
+    LCLSendSizeMsg(Target, Round(sz.width), Round(sz.height), SIZENORMAL);
+end;
+
+function AllocCustomControl(const AWinControl: TWinControl): TCocoaCustomControl;
+begin
+  if not Assigned(AWinControl) then begin
+    Result:=nil;
+    Exit;
+  end;
+  Result:=TCocoaCustomControl(TCocoaCustomControl.alloc).init;
+  Result.callback:=TLCLCommonCallback.Create(Result, AWinControl);
+end;
+
+procedure SetViewDefaults(AView:NSView);
+begin
+  if not Assigned(AView) then Exit;
+  AView.setAutoresizingMask(NSViewMinYMargin or NSViewMaxXMargin);
+end;
+
+
+{ TLCLCommonCallback }
+
+constructor TLCLCommonCallback.Create(AOwner: NSObject; ATarget: TControl);
+begin
+  inherited Create(AOwner);
+  Target:=ATarget;
+end;
+
+destructor TLCLCommonCallback.Destroy;
+begin
+  Context.Free;
+  inherited Destroy;
+end;
+
+procedure TLCLCommonCallback.MouseDown(x, y: Integer);
+begin
+  LCLSendMouseDownMsg(Target,x,y,mbLeft, []);
+end;
+
+procedure TLCLCommonCallback.MouseUp(x, y: Integer);
+begin
+  LCLSendMouseUpMsg(Target,x,y,mbLeft, []);
+end;
+
+procedure TLCLCommonCallback.MouseClick(clickCount: Integer);
+begin
+  LCLSendClickedMsg(Target);
+end;
+
+procedure TLCLCommonCallback.MouseMove(x, y: Integer);
+begin
+  LCLSendMouseMoveMsg(Target, x,y, []);
+end;
+
+procedure TLCLCommonCallback.Draw(ControlContext: NSGraphicsContext;
+  const bounds, dirty:NSRect);
+var
+  struct : TPaintStruct;
+begin
+  if not Assigned(Context) then Context:=TCocoaContext.Create;
+
+  Context.ctx:=ControlContext;
+  if Context.InitDraw(Round(bounds.size.width), Round(bounds.size.height)) then
+  begin
+    FillChar(struct, SizeOf(TPaintStruct), 0);
+    struct.hdc := HDC(Context);
+    {$IFDEF VerboseWinAPI}
+      DebugLn(Format('[TLCLCommonCallback.Draw] OnPaint event started context: %x', [HDC(context)]));
+    {$ENDIF}
+    LCLSendPaintMsg(Target, HDC(Context), @struct);
+    {$IFDEF VerboseWinAPI}
+      DebugLn('[TLCLCommonCallback.Draw] OnPaint event ended');
+    {$ENDIF}
+  end;
+end;
+
+{ TCocoaWSWinControl }
+
+class function TCocoaWSWinControl.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+begin
+  Result:=TCocoaWSCustomControl.CreateHandle(AWinControl, AParams);
+end;
+
+class procedure TCocoaWSWinControl.SetText(const AWinControl: TWinControl; const AText: String);
+var
+  obj : NSObject;
+begin
+  // sanity check
+  obj:=NSObject(AWinControl.Handle);
+  if not Assigned(obj) or not obj.isKindOfClass_(NSControl) then Exit;
+
+  SetNSControlValue(NSControl(obj), AText);
+end;
+
+class function TCocoaWSWinControl.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
+var
+  obj   : NSObject;
+begin
+  Result:=false;
+
+  // sanity check
+  obj:=NSObject(AWinControl.Handle);
+  Result:=Assigned(obj) and obj.isKindOfClass_(NSControl);
+  if not Result then Exit;
+
+  AText:=GetNSControlValue(NSControl(obj));
+  Result:=true;
+end;
+
+class function TCocoaWSWinControl.GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean;
+var
+  obj : NSObject;
+  s   : NSString;
+begin
+  Result:=false;
+
+  // sanity check
+  obj:=NSObject(AWinControl.Handle);
+  Result:= Assigned(obj) and obj.isKindOfClass_(NSControl);
+  if not Result then Exit;
+
+  s:=NSControl(obj).stringValue;
+  if Assigned(s) then ALength:=s.length
+  else ALength:=0
+end;
+
+class function TCocoaWSWinControl.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
+begin
+  Result:=(AWinControl.Handle<>0);
+  if not Result then Exit;
+  ARect:=NSObject(AWinControl.Handle).lclClientFrame;
+end;
+
+class function TCocoaWSWinControl.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
+begin
+  Result:=(AWinControl.Handle<>0);
+  if not Result then Exit;
+  ARect:=NSObject(AWinControl.Handle).lclClientFrame;
+end;
+
+class procedure TCocoaWSWinControl.SetBounds(const AWinControl: TWinControl;
+  const ALeft, ATop, AWidth, AHeight: Integer);
+begin
+  if (AWinControl.Handle<>0) then
+    NSObject(AWinControl.Handle).lclSetFrame(Bounds(ALeft, ATop, AWidth, AHeight));
+end;
+
+{ TCocoaWSCustomControl }
+
+class function TCocoaWSCustomControl.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+var
+  ctrl  : TCocoaCustomControl;
+begin
+  ctrl:=TCocoaCustomControl( NSView(TCocoaCustomControl.alloc).lclInitWithCreateParams(AParams));
+  ctrl.callback:=TLCLCommonCallback.Create(ctrl, AWinControl);
+  Result:=TLCLIntfHandle(ctrl);
+end;
+
+{ LCLWSViewExtension }
+
+function LCLWSViewExtension.lclInitWithCreateParams(const AParams:TCreateParams): id;
+var
+  p: NSView;
+  ns: NSRect;
+begin
+  p:=nil;
+  if (AParams.WndParent<>0) then begin
+    if (NSObject(AParams.WndParent).isKindOfClass_(NSView)) then
+      p:=NSView(AParams.WndParent)
+    else if (NSObject(AParams.WndParent).isKindOfClass_(NSWindow)) then
+      p:=NSWindow(AParams.WndParent).contentView;
+  end;
+  with AParams do
+    if Assigned(p)
+      then LCLToNSRect(Types.Bounds(X,Y,Width, Height), p.frame.size.height, ns)
+      else LCLToNSRect(Types.Bounds(X,Y,Width, Height), ns);
+
+  Result:=initWithFrame(ns);
+  if not Assigned(Result) then Exit;
+
+  if Assigned(p) then p.addSubview(Self);
+  SetViewDefaults(Self);
+end;
+
+end.
+

lcl/interfaces/customdrawn/cocoautils.pas

@@ -0,0 +1,261 @@
+unit CocoaUtils;
+
+{$mode objfpc}{$H+}
+{$modeswitch objectivec1}
+
+interface
+
+uses
+  MacOSAll, CocoaAll,
+  Types, LCLType;
+
+type
+  { NSLCLDebugExtension }
+
+  NSLCLDebugExtension = objccategory(NSObject)
+    function lclClassName: shortstring; message 'lclClassName';
+  end;
+
+const
+  NSNullRect : NSRect = (origin:(x:0; y:0); size:(width:0; height:0));
+
+function GetNSPoint(x,y: single): NSPoint; inline;
+
+function GetCGRect(x1, y1, x2, y2: Integer): CGRect;
+function CGRectToRect(const c: CGRect): TRect;
+
+function GetNSRect(x, y, width, height: Integer): NSRect; inline;
+function RectToNSRect(const r: TRect): NSRect;
+
+procedure NSToLCLRect(const ns: NSRect; var lcl: TRect); overload;
+procedure NSToLCLRect(const ns: NSRect; ParentHeight: Single; var lcl: TRect); overload;
+
+procedure LCLToNSRect(const lcl: TRect; var ns: NSRect); overload;
+procedure LCLToNSRect(const lcl: TRect; ParentHeight: Single; var ns: NSRect); overload;
+
+function CreateParamsToNSRect(const params: TCreateParams): NSRect;
+
+function NSStringUtf8(s: PChar): NSString;
+function NSStringUtf8(const s: String): NSString;
+function NSStringToString(ns: NSString): String;
+
+function GetNSObjectView(obj: NSObject): NSView;
+procedure AddViewToNSObject(ctrl: NSView; obj: NSObject);
+procedure AddViewToNSObject(ctrl: NSView; obj: NSObject; X,Y: integer);
+
+procedure SetNSText(text: NSText; const s: String); inline;
+function GetNSText(text: NSText): string; inline;
+
+procedure SetNSControlValue(c: NSControl; const S: String); inline;
+function GetNSControlValue(c: NSControl): String; inline;
+
+implementation
+
+const
+  DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
+
+function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): String;
+var
+  Str: Pointer;
+  StrSize: CFIndex;
+  StrRange: CFRange;
+begin
+  if AString = nil then
+  begin
+    Result := '';
+    Exit;
+  end;
+
+  // Try the quick way first
+  Str := CFStringGetCStringPtr(AString, Encoding);
+  if Str <> nil then
+    Result := PChar(Str)
+  else
+  begin
+    // if that doesn't work this will
+    StrRange.location := 0;
+    StrRange.length := CFStringGetLength(AString);
+
+    CFStringGetBytes(AString, StrRange, Encoding,
+      Ord('?'), False, nil, 0, StrSize);
+    SetLength(Result, StrSize);
+
+    if StrSize > 0 then
+      CFStringGetBytes(AString, StrRange, Encoding,
+        Ord('?'), False, @Result[1], StrSize, StrSize);
+  end;
+end;
+
+function GetNSObjectView(obj: NSObject): NSView;
+begin
+  Result:=nil;
+  if not Assigned(obj) then Exit;
+  if obj.isKindOfClass_(NSView) then Result:=NSView(obj)
+  else if obj.isKindOfClass_(NSWindow) then Result:=NSWindow(obj).contentView;
+end;
+
+procedure AddViewToNSObject(ctrl: NSView; obj: NSObject);
+var
+  view : NSView;
+begin
+  view:=GetNSObjectView(obj);
+  if not Assigned(view) then Exit;
+  view.addSubView(ctrl);
+end;
+
+procedure AddViewToNSObject(ctrl: NSView; obj: NSObject; X,Y: integer);
+begin
+  AddViewToNSObject(ctrl, obj);
+  //SetViewFramePos(ctrl, x,y);
+end;
+
+function GetNSPoint(x, y: single): NSPoint;
+begin
+  Result.x:=x;
+  Result.y:=y;
+end;
+
+function GetNSRect(x, y, width, height: Integer): NSRect;
+begin
+  Result.origin.x:=x;
+  Result.origin.y:=y;
+  Result.size.width:=width;
+  Result.size.height:=height;
+end;
+
+function GetCGRect(x1, y1, x2, y2: Integer): CGRect;
+begin
+  Result.origin.x:=x1;
+  Result.origin.y:=y1;
+  Result.size.width:=x2-x1;
+  Result.size.height:=y2-y1;
+end;
+
+function CGRectToRect(const c:CGRect):TRect;
+begin
+  with Result do begin
+    Left:=round(c.origin.x);
+    Top:=round(c.origin.y);
+    Right:=round(c.origin.x+c.size.width);
+    Bottom:=round(c.origin.y+c.size.height);
+  end;
+end;
+
+function RectToNSRect(const r: TRect): NSRect;
+begin
+  Result:=GetNSRect(r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top);
+end;
+
+procedure NSToLCLRect(const ns: NSRect; var lcl: TRect);
+begin
+  lcl.Left:=round(ns.origin.x);
+  lcl.Top:=round(ns.origin.y);
+  lcl.Right:=round(ns.origin.x+ns.size.width);
+  lcl.Bottom:=round(ns.origin.y+ns.size.height);
+end;
+
+procedure NSToLCLRect(const ns: NSRect; ParentHeight: Single; var lcl: TRect);
+begin
+  lcl.Left:=Round(ns.origin.x);
+  lcl.Top:=Round(ParentHeight-ns.size.height-ns.origin.y);
+  lcl.Right:=Round(ns.origin.x+ns.size.width);
+  lcl.Bottom:=Round(lcl.Top+ns.size.height);
+end;
+
+procedure LCLToNSRect(const lcl: TRect; var ns: NSRect); overload;
+begin
+  ns.origin.x:=lcl.Left;
+  ns.origin.y:=lcl.Top;
+  ns.size.width:=lcl.Right-lcl.Left;
+  ns.size.height:=lcl.Bottom-lcl.Top;
+end;
+
+procedure LCLToNSRect(const lcl: TRect; ParentHeight: Single; var ns: NSRect); overload;
+begin
+  ns.origin.x:=lcl.left;
+  ns.origin.y:=ParentHeight-(lcl.bottom-lcl.Top)-lcl.Top;
+  ns.size.width:=lcl.Right-lcl.Left;
+  ns.size.height:=lcl.Bottom-lcl.Top;
+end;
+
+
+function CreateParamsToNSRect(const params: TCreateParams): NSRect;
+begin
+  with params do Result:=GetNSRect(X,Y,Width,Height);
+end;
+
+function NSStringUtf8(s: PChar): NSString;
+var
+  cf : CFStringRef;
+begin
+  {NSString and CFStringRef are interchangable}
+  cf:=CFStringCreateWithCString(nil, S, kCFStringEncodingUTF8);
+  Result:=NSString(cf);
+end;
+
+function NSStringUtf8(const s: String): NSString;
+var
+  cf : CFStringRef;
+begin
+  {NSString and CFStringRef are interchangable}
+  cf:=CFStringCreateWithCString(nil, Pointer(PChar(S)), kCFStringEncodingUTF8);
+  Result:=NSString(cf);
+end;
+
+function NSStringToString(ns: NSString): String;
+begin
+  Result:=CFStringToStr(CFStringRef(ns));
+end;
+
+procedure SetNSText(text: NSText; const s: String); inline;
+var
+  ns : NSString;
+begin
+  if Assigned(text) then
+  begin
+    ns:=NSStringUTF8(s);
+    text.setString(ns);
+    ns.release;
+  end;
+end;
+
+function GetNSText(text: NSText): string; inline;
+begin
+  if Assigned(text) then
+    Result := NSStringToString(text.string_)
+  else
+    Result:='';
+end;
+
+procedure SetNSControlValue(c: NSControl; const S: String); inline;
+var
+  ns : NSString;
+begin
+  if Assigned(c) then
+  begin
+    ns:=NSStringUtf8(S);
+    c.setStringValue(ns);
+    ns.release;
+  end;
+end;
+
+function GetNSControlValue(c: NSControl): String; inline;
+begin
+  if Assigned(c) then
+    Result:=NSStringToString(c.stringValue)
+  else
+    Result:='';
+end;
+
+
+{ NSLCLDebugExtension }
+
+function NSLCLDebugExtension.lclClassName: shortstring;
+begin
+  Result:=NSStringToString(self.className);
+end;
+
+initialization
+
+end.
+

lcl/interfaces/customdrawn/customdrawnwscontrols.pp

@@ -60,6 +60,7 @@ type
 
   TCDWSWinControl = class(TWSWinControl)
   published
+    {$ifdef CD_Windows}
     class procedure AddControl(const AControl: TControl); override;
 
     class function  GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
@@ -78,6 +79,7 @@ type
     class procedure DestroyHandle(const AWinControl: TWinControl); override;
     class procedure Invalidate(const AWinControl: TWinControl); override;
     class procedure ShowHide(const AWinControl: TWinControl); override;
+    {$endif}
 
 {    class function  CanFocus(const AWinControl: TWinControl): Boolean; override;
     class function  CreateHandle(const AWinControl: TWinControl;

lcl/interfaces/customdrawn/customdrawnwsforms.pp

@@ -33,14 +33,14 @@ uses
   // RTL
   SysUtils, Classes,
   {$ifdef CD_Windows}Windows, WinProc,{$endif}
+  {$ifdef CD_Cocoa}MacOSAll, CocoaAll, CocoaPrivate, CocoaUtils,{$endif}
   // LCL
-  Controls, LCLType, Forms,
+  Controls, LCLType, Forms, LCLProc,
   // Widgetset
-  InterfaceBase, WSForms, WSProc, WSLCLClasses,
+  InterfaceBase, WSForms, WSProc, WSLCLClasses, LCLMessageGlue,
   customdrawnwscontrols, customdrawnint;
 
 type
-
   { TCDWSScrollingWinControl }
 
   TCDWSScrollingWinControl = class(TWSScrollingWinControl)
@@ -81,11 +81,12 @@ type
      Bounds: TRect; lForm: TCustomForm);
     {$endif}
   published
-    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
 //    class procedure DestroyHandle(const AWinControl: TWinControl); override;
 
     class procedure SetBounds(const AWinControl: TWinControl;
       const ALeft, ATop, AWidth, AHeight: Integer); override;
+    {$ifdef CD_Windows}
     class procedure SetBorderIcons(const AForm: TCustomForm;
                                    const ABorderIcons: TBorderIcons); override;
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
@@ -93,7 +94,16 @@ type
     class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
     class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override;
     class procedure ShowModal(const ACustomForm: TCustomForm); override;
+    {$endif}
     class procedure ShowHide(const AWinControl: TWinControl); override;
+
+    {$ifdef CD_Cocoa}
+    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 function  GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
+    class function  GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean; override;
+    {$endif}
 {    class function  CanFocus(const AWinControl: TWinControl): Boolean; override;
 
     class procedure CloseModal(const ACustomForm: TCustomForm); override;
@@ -142,5 +152,8 @@ implementation
 {$ifdef CD_Windows}
   {$include customdrawnwsforms_win.inc}
 {$endif}
+{$ifdef CD_Cocoa}
+  {$include customdrawnwsforms_cocoa.inc}
+{$endif}
 
 end.

lcl/interfaces/customdrawn/customdrawnwsforms_cocoa.inc

@@ -0,0 +1,124 @@
+{$MainUnit customdrawnwsforms.pp}
+
+{ TCDWSCustomForm }
+
+{------------------------------------------------------------------------------
+  Method:  TCDWSCustomForm.CreateHandle
+  Params:  AWinControl - LCL control
+           AParams     - Creation parameters
+  Returns: Handle to the window in Cocoa interface
+
+  Creates new window in Cocoa interface with the specified parameters
+ ------------------------------------------------------------------------------}
+
+class function TCDWSCustomForm.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+var
+  win : TCocoaWindow;
+  cnt : TCocoaCustomControl;
+  ns  : NSString;
+const
+  WinMask = NSTitledWindowMask or NSClosableWindowMask or NSMiniaturizableWindowMask or NSResizableWindowMask;
+begin
+  win := TCocoaWindow(TCocoaWindow.alloc);
+
+  if not Assigned(win) then begin
+    Result:=0;
+    Exit;
+  end;
+
+  win:=TCocoaWindow(win.initWithContentRect_styleMask_backing_defer(CreateParamsToNSRect(AParams), WinMask, NSBackingStoreBuffered, False));
+  TCocoaWindow(win).callback:=TLCLCommonCallback.Create(win, AWinControl);
+  TCocoaWindow(win).wincallback:=TLCLWindowCallback.Create(win, AWinControl);
+  win.setDelegate(win);
+  ns:=NSStringUtf8(AWinControl.Caption);
+  win.setTitle(ns);
+  ns.release;
+  win.setAcceptsMouseMovedEvents(True);
+
+  cnt:=TCocoaCustomControl.alloc.init;
+  cnt.callback:=TCocoaWindow(win).callback;
+  win.setContentView(cnt);
+
+  Result := TLCLIntfHandle(win);
+end;
+
+class procedure TCDWSCustomForm.ShowHide(const AWinControl: TWinControl);
+var
+  win : NSWindow;
+begin
+  win:=NSWindow(AWinControl.Handle);
+  if not Assigned(win) then Exit;
+
+  if AWinControl.Visible then
+    win.orderFrontRegardless
+  else
+    win.orderOut(nil);
+end;
+
+class function TCDWSCustomForm.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
+var
+  win   : TCocoaWindow;
+begin
+  win:=TCocoaWindow(AWinControl.Handle);
+  Result:=Assigned(win);
+  if not Result then Exit;
+  AText:=NSStringToString(win.title);
+  Result:=true;
+end;
+
+class function TCDWSCustomForm.GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean;
+var
+  win   : TCocoaWindow;
+begin
+  win:=TCocoaWindow(AWinControl.Handle);
+  Result:=Assigned(win);
+  if not Result then Exit;
+  ALength:=win.title.length;
+end;
+
+class procedure TCDWSCustomForm.SetText(const AWinControl: TWinControl; const AText: String);
+var
+  win : TCocoaWindow;
+  ns  : NSString;
+begin
+  win:=TCocoaWindow(AWinControl.Handle);
+  if not Assigned(win) then Exit;
+  ns:=NSStringUtf8(AText);
+  win.setTitle(ns);
+  ns.release;
+end;
+
+class function TCDWSCustomForm.GetClientBounds(const AWinControl: TWinControl; var ARect: TRect): Boolean;
+begin
+  Result:=AWinControl.Handle<>0;
+  if not Result then Exit;
+  ARect:=NSObject(AWinControl.Handle).lclClientFrame;
+end;
+
+class function TCDWSCustomForm.GetClientRect(const AWinControl: TWinControl; var ARect: TRect): Boolean;
+var
+  x,y : Integer;
+begin
+  Result:=AWinControl.Handle<>0;
+  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 TCDWSCustomForm.SetBounds(const AWinControl: TWinControl;
+  const ALeft, ATop, AWidth, AHeight: Integer);
+begin
+  if AWinControl.Handle=0 then Exit;
+  {todo: setFrame_display(, true)? }
+  //sf:=NSScreen.mainScreen.frame;
+  NSObject(AWinControl.Handle).lclSetFrame(Bounds(ALeft, ATop, AWidth, AHeight));
+
+  //LCLToCocoaRect( GetNSRect(ALeft,ATop,AWidth,AHeight), sf, wf);
+  //NSWindow(AWinControl.Handle).setFrame_display(wf, false);
+  //NSWindow(AWinControl.Handle).setFrame_display( GetNSRect(ALeft,ATop, AWidth, AHeight), false);
+  //NSWindow(AWinControl.Handle).setFrameTopLeftPoint( GetNSPoint(ALeft, ATop));
+end;
+