Carbon intf:

- fixed setting root menu
- working: TArrow, TPairSplitter

git-svn-id: trunk@11936 -

lcl/interfaces/carbon/carboncanvas.pp

@@ -623,7 +623,6 @@ begin
 
   // change coordination system
   CGContextScaleCTM(CGContext, 1, -1);
-  CGContextTranslateCTM(CGContext, 0, 0);
 
   // convert UTF-8 string to UTF-16 string
   if ACount < 0 then S := AStr

lcl/interfaces/carbon/carbondebug.inc

@@ -20,7 +20,7 @@
   
 // Show debug info when tracing:
 
-{.$define DebugBitmaps}
+{off $define DebugBitmaps}
 
 {off $DEFINE DebugEventLoop}
 

lcl/interfaces/carbon/carbonint.pas

@@ -133,7 +133,7 @@ uses
 // uncomment only those units with implementation
 ////////////////////////////////////////////////////
 // CarbonWSActnList,
-// CarbonWSArrow,
+  CarbonWSArrow,
   CarbonWSButtons,
 // CarbonWSCalendar,
  CarbonWSCheckLst,
@@ -153,7 +153,7 @@ uses
 // CarbonWSImgList,
 // CarbonWSMaskEdit,
   CarbonWSMenus,
-// CarbonWSPairSplitter,
+  CarbonWSPairSplitter,
   CarbonWSSpin,
   CarbonWSStdCtrls,
 // CarbonWSToolwin,

lcl/interfaces/carbon/carbonlclintf.inc

@@ -56,6 +56,64 @@ begin
   {$ENDIF}
 end;
 
+{------------------------------------------------------------------------------
+  Method:  DrawArrow
+  Params:  Arrow  - LCL arrow
+           Canvas - LCL canvas
+
+  Draws the arrow on the specified canvas
+ ------------------------------------------------------------------------------}
+procedure TCarbonWidgetSet.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
+var
+  ArrowCanvas: TCanvas;
+  P: Array [0..2] of TPoint;
+  R: TRect;
+  S: Integer;
+begin
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.DrawArrow Arrow: ' + DbgS(Arrow));
+  {$ENDIF}
+  
+  R := TControl(Arrow).ClientRect;
+  InflateRect(R, -1, -1);
+  // arrow bounds are square
+  S := Min(R.Right - R.Left, R.Bottom - R.Top);
+  R := Bounds((R.Left + R.Right - S) div 2, (R.Top + R.Bottom - S) div 2, S, S);
+
+  ArrowCanvas := TCanvas(Canvas);
+  ArrowCanvas.Brush.Color := clBlack;
+  ArrowCanvas.Pen.Color := clBlack;
+  
+  case Ord(TArrow(Arrow).ArrowType) of
+    0: // up
+      begin
+        P[0] := Classes.Point(R.Left, R.Bottom);
+        P[1] := Classes.Point((R.Left + R.Right) div 2, R.Top);
+        P[2] := R.BottomRight;
+      end;
+    1: // down
+      begin
+        P[0] := R.TopLeft;
+        P[1] := Classes.Point(R.Right, R.Top);
+        P[2] := Classes.Point((R.Left + R.Right) div 2, R.Bottom);
+      end;
+    2: // left
+      begin
+        P[0] := R.BottomRight;
+        P[1] := Classes.Point(R.Left, (R.Top + R.Bottom) div 2);
+        P[2] := Classes.Point(R.Right, R.Top);
+      end;
+    3: // right
+      begin
+        P[0] := R.TopLeft;
+        P[1] := Classes.Point(R.Right, (R.Top + R.Bottom) div 2);
+        P[2] := Classes.Point(R.Left, R.Bottom);
+      end;
+  end;
+  
+  ArrowCanvas.Polygon(P);
+end;
+
 function TCarbonWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
   Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
 begin
@@ -474,6 +532,7 @@ begin
   
   if FMainMenu <> nil then
   begin
+    if csDesigning in FMainMenu.ComponentState then Exit;
     if FMainMenu.Items.HandleAllocated then
     begin
       TCarbonMenu(FMainMenu.Items.Handle).SetEnable(AEnabled);
@@ -489,14 +548,20 @@ end;
  ------------------------------------------------------------------------------}
 procedure TCarbonWidgetSet.SetRootMenu(const AMenu: TMainMenu);
 begin
-  if (AMenu <> nil) and AMenu.HandleAllocated then
+  {$IFDEF VerboseLCLIntf}
+    DebugLn('TCarbonWidgetSet.SetRootMenu AMenu: ' + DbgS(AMenu));
+  {$ENDIF}
+  
+  if (AMenu <> nil) and not (csDesigning in AMenu.ComponentState) and
+    AMenu.HandleAllocated then
   begin
+
     if not CheckMenu(AMenu.Handle, 'SetRootMenu') then Exit;
 
     TCarbonMenu(AMenu.Handle).AttachToMenuBar;
-  end
-  else
-    OSError(FPCMacOSAll.SetRootMenu(EmptyMenu), Self, 'SetRootMenu', 'SetRootMenu');
+    
+    FMainMenu := AMenu;
+  end;
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonlclintfh.inc

@@ -28,6 +28,7 @@
 //##apiwiz##sps##   // Do not remove
 
 function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
+procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
 
 function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
   Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;

lcl/interfaces/carbon/carbonmenus.pp

@@ -74,8 +74,6 @@ type
   
 function CheckMenu(const Menu: HMENU; const AMethodName: String; AParamName: String = ''): Boolean;
 
-var
-  EmptyMenu: MenuRef; // menu for clearing menu bar workaround
 
 implementation
 
@@ -614,14 +612,6 @@ begin
   SetItemStyle(FParentMenu.Menu, GetIndex + 1, Style);
 end;
 
-initialization
-
-  OSError(CreateNewMenu(0, kMenuAttrAutoDisable, EmptyMenu),
-    'CarbonMenus.initialization', 'CreateNewMenu');
-
-finalization
-
-  DisposeMenu(EmptyMenu);
 
 end.
 

lcl/interfaces/carbon/carbonobject.inc

@@ -891,7 +891,8 @@ begin
     DebugLn('TCarbonWidgetSet.AttachMenuToWindow ' + AMenuObject.Name);
   {$ENDIF}
   
-  // menus are attached on each form activation
+  if AMenuObject is TMainMenu then
+    SetRootMenu(AMenuObject as TMainMenu);
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/carbon/carbonprivatecontrol.inc

@@ -970,15 +970,18 @@ end;
   Returns the control client rectangle relative to the control origin
  ------------------------------------------------------------------------------}
 function TCarbonControl.GetClientRect(var ARect: TRect): Boolean;
+var
+  R: HIRect;
 begin
   Result := False;
 
   // controls without content area have clientrect = boundsrect
-  if GetFrameBounds(ARect) then
-  begin
-    OffsetRect(ARect, -ARect.Left, -ARect.Top);
-    Result := True;
-  end;
+  if OSError(HIViewGetFrame(Content, R),
+    Self, 'GetClientRect', 'HIViewGetFrame') then Exit;
+
+  ARect := CGrectToRect(R);
+  OffsetRect(ARect, -ARect.Left, -ARect.Top);
+  Result := True;
 
   {$IFDEF VerboseBounds}
     DebugLn('TCarbonControl.GetClientRect ' + LCLObject.Name + ' ' + DbgS(ARect) +

lcl/interfaces/carbon/carbonprivatewindow.inc

@@ -748,19 +748,12 @@ begin
         if (AWidget.LCLObject is TCustomForm) then
           CarbonWidgetSet.SetRootMenu((AWidget.LCLObject as TCustomForm).Menu);
       end;
-    kEventWindowDeactivated:
-      begin
-        Msg.msg := LM_DEACTIVATE;
-        if (AWidget.LCLObject is TCustomForm) then
-          CarbonWidgetSet.SetRootMenu(nil);
-      end;
+    kEventWindowDeactivated: Msg.msg := LM_DEACTIVATE;
   else
     DebugLn('CarbonWindow_ActivateProc invalid event kind: ' + DbgS(EventKind));
     Exit;
   end;
   
-
-  
   DeliverMessage(AWidget.LCLObject, Msg);
 end;
 

lcl/interfaces/carbon/carbonwsarrow.pp

@@ -33,7 +33,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-//  Arrow,
+  Arrow,
 ////////////////////////////////////////////////////
   WSArrow, WSLCLClasses;
 
@@ -45,11 +45,21 @@ type
   private
   protected
   public
+    class procedure SetType(const AArrow: TArrow; const AArrowType: TArrowType;
+      const AShadowType: TShadowType); override;
   end;
 
 
 implementation
 
+{ TCarbonWSArrow }
+
+class procedure TCarbonWSArrow.SetType(const AArrow: TArrow;
+  const AArrowType: TArrowType; const AShadowType: TShadowType);
+begin
+  // TODO
+end;
+
 initialization
 
 ////////////////////////////////////////////////////
@@ -58,6 +68,6 @@ initialization
 // To improve speed, register only classes
 // which actually implement something
 ////////////////////////////////////////////////////
-//  RegisterWSComponent(TArrow, TCarbonWSArrow);
+  RegisterWSComponent(TArrow, TCarbonWSArrow);
 ////////////////////////////////////////////////////
-end.
+end.

lcl/interfaces/carbon/carbonwspairsplitter.pp

@@ -33,7 +33,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-//  PairSplitter,
+  Controls, LCLType, PairSplitter,
 ////////////////////////////////////////////////////
   WSPairSplitter, WSLCLClasses;
 
@@ -45,6 +45,7 @@ type
   private
   protected
   public
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
   end;
 
   { TCarbonWSCustomPairSplitter }
@@ -53,6 +54,7 @@ type
   private
   protected
   public
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
   end;
 
   { TCarbonWSPairSplitter }
@@ -66,16 +68,54 @@ type
 
 implementation
 
+uses
+  CarbonPrivate;
+  
+{ TCarbonWSPairSplitterSide }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSPairSplitterSide.CreateHandle
+  Params:  AWinControl - LCL control
+           AParams     - Creation parameters
+  Returns: Handle to the control in Carbon interface
+
+  Creates new pair splitter side in Carbon interface with the specified
+  parameters
+ ------------------------------------------------------------------------------}
+class function TCarbonWSPairSplitterSide.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+begin
+  Result := TLCLIntfHandle(TCarbonCustomControl.Create(AWinControl, AParams));;
+end;
+
+{ TCarbonWSCustomPairSplitter }
+
+{------------------------------------------------------------------------------
+  Method:  TCarbonWSCustomPairSplitter.CreateHandle
+  Params:  AWinControl - LCL control
+           AParams     - Creation parameters
+  Returns: Handle to the control in Carbon interface
+
+  Creates new pair splitter in Carbon interface with the specified parameters
+ ------------------------------------------------------------------------------}
+class function TCarbonWSCustomPairSplitter.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+begin
+  Result := TLCLIntfHandle(TCarbonCustomControl.Create(AWinControl, AParams));;
+end;
+
 initialization
 
+
+
 ////////////////////////////////////////////////////
 // I M P O R T A N T
 ////////////////////////////////////////////////////
 // To improve speed, register only classes
 // which actually implement something
 ////////////////////////////////////////////////////
-//  RegisterWSComponent(TPairSplitterSide, TCarbonWSPairSplitterSide);
-//  RegisterWSComponent(TCustomPairSplitter, TCarbonWSCustomPairSplitter);
+  RegisterWSComponent(TPairSplitterSide, TCarbonWSPairSplitterSide);
+  RegisterWSComponent(TCustomPairSplitter, TCarbonWSCustomPairSplitter);
 //  RegisterWSComponent(TPairSplitter, TCarbonWSPairSplitter);
 ////////////////////////////////////////////////////
-end.
+end.