cocoa: Adds a skeleton BitBtn structure to avoid crashes

git-svn-id: trunk@30315 -

.gitattributes

@@ -5168,6 +5168,7 @@ lcl/interfaces/cocoa/cocoatrayicon.inc svneol=native#text/plain
 lcl/interfaces/cocoa/cocoautils.pas svneol=native#text/plain
 lcl/interfaces/cocoa/cocoawinapi.inc svneol=native#text/plain
 lcl/interfaces/cocoa/cocoawinapih.inc svneol=native#text/plain
+lcl/interfaces/cocoa/cocoawsbuttons.pp svneol=native#text/pascal
 lcl/interfaces/cocoa/cocoawscommon.pas svneol=native#text/plain
 lcl/interfaces/cocoa/cocoawsextctrls.pas svneol=native#text/plain
 lcl/interfaces/cocoa/cocoawsfactory.pas svneol=native#text/plain

lcl/interfaces/cocoa/cocoawsbuttons.pp

@@ -0,0 +1,148 @@
+{
+ *****************************************************************************
+ *                              CocoaWSButtons.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 copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+unit cocoawsbuttons;
+
+{$mode objfpc}{$H+}
+
+interface
+
+// defines
+//{$I carbondefines.inc}
+
+uses
+  // libs
+  MacOSAll,
+  // LCL
+  Classes, Controls, Buttons, LCLType, LCLProc, Graphics,
+  // widgetset
+  WSButtons, WSLCLClasses, WSProc;
+  // LCL Carbon
+//  CarbonDef, CarbonPrivate, CarbonButtons, CarbonWSControls, CarbonGDIObjects};
+
+type
+
+  { TCocoaWSBitBtn }
+
+  TCocoaWSBitBtn = class(TWSBitBtn)
+  published
+    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
+    class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
+    class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
+  end;
+
+  { TCocoaWSSpeedButton }
+
+  TCocoaWSSpeedButton = class(TWSSpeedButton)
+  published
+  end;
+
+
+implementation
+
+{ TCocoaWSBitBtn }
+
+{------------------------------------------------------------------------------
+  Method:  TCocoaWSBitBtn.CreateHandle
+  Params:  AWinControl - LCL control
+           AParams     - Creation parameters
+  Returns: Handle to the control in Carbon interface
+
+  Creates new bevel button with bitmap in Carbon interface with the
+  specified parameters
+ ------------------------------------------------------------------------------}
+class function TCocoaWSBitBtn.CreateHandle(const AWinControl: TWinControl;
+  const AParams: TCreateParams): TLCLIntfHandle;
+begin
+//  Result := TLCLIntfHandle(TCarbonBitBtn.Create(AWinControl, AParams));
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCocoaWSBitBtn.SetGlyph
+  Params:  ABitBtn - LCL custom bitmap button
+           AValue  - Bitmap
+
+  Sets the bitmap of bevel button in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCocoaWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
+  const AValue: TButtonGlyph);
+{var
+  Img     : CGImageRef;
+  R       : TRect;}
+begin
+{  if not CheckHandle(ABitBtn, Self, 'SetGlyph') then Exit;
+
+  Img := nil;
+  if ABitBtn.CanShowGlyph and (AValue.Glyph <> nil) and (AValue.Glyph.Width > 0) and (AValue.Glyph.Height > 0) then
+  begin
+    if TObject(AValue.Glyph.Handle) is TCarbonBitmap then
+    begin
+      if AValue.NumGlyphs <= 1 then
+        Img := TCarbonBitmap(AValue.Glyph.Handle).CreateMaskedImage(TCarbonBitmap(AValue.Glyph.MaskHandle))
+      else
+      begin
+        // TODO: consider button style (down, disabled)
+        R := Classes.Rect(0, 0, AValue.Glyph.Width div ABitBtn.NumGlyphs, AValue.Glyph.Height);
+        Img := TCarbonBitmap(AValue.Glyph.Handle).CreateMaskedImage(TCarbonBitmap(AValue.Glyph.MaskHandle), R);
+      end;
+    end;
+  end;
+
+  {if ABitBtn.CanShowGlyph then
+    TCarbonBitBtn(ABitBtn.Handle).SetGlyph(AValue.Glyph)
+  else}
+  TCarbonBitBtn(ABitBtn.Handle).SetGlyph(Img);}
+end;
+
+{------------------------------------------------------------------------------
+  Method:  TCocoaWSBitBtn.SetLayout
+  Params:  ABitBtn - LCL custom bitmap button
+           AValue  - Bitmap and caption layout
+
+  Sets the bitmap and caption layout of bevel button in Carbon interface
+ ------------------------------------------------------------------------------}
+class procedure TCocoaWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
+  const AValue: TButtonLayout);
+{var
+  Placement: ControlButtonTextPlacement;
+  TextAlign: ControlButtonTextAlignment;}
+begin
+{  if not CheckHandle(ABitBtn, Self, 'SetLayout') then Exit;
+
+  if (ABitBtn.CanShowGlyph) and (ABitBtn.Glyph <> nil) and (ABitBtn.Glyph.Width > 0) and (ABitBtn.Glyph.Height > 0) then
+  begin
+    TextAlign := kControlBevelButtonAlignLeft;
+    case AValue of
+      blGlyphLeft  : Placement := kControlBevelButtonPlaceToRightOfGraphic;
+      blGlyphRight : Placement := kControlBevelButtonPlaceToLeftOfGraphic;
+      blGlyphTop   : Placement := kControlBevelButtonPlaceBelowGraphic;
+      blGlyphBottom: Placement := kControlBevelButtonPlaceAboveGraphic;
+    end;
+  end
+  else // if Glyph is empty, then align center
+  begin
+    TextAlign := kControlBevelButtonAlignTextCenter;
+    Placement := kControlBevelButtonPlaceNormally;
+  end;
+  TCarbonBitBtn(ABitBtn.Handle).SetLayout(Placement, TextAlign);}
+end;
+
+end.

lcl/interfaces/cocoa/cocoawsfactory.pas

@@ -9,6 +9,7 @@ uses
   Dialogs, ExtCtrls, Buttons, CheckLst, Forms, Menus,
   WSLCLClasses,
   CocoaWSCommon,
+  CocoaWSButtons,
   CocoaWSExtCtrls,
   CocoaWSForms,
   CocoaWSMenus,
@@ -421,7 +422,8 @@ end;
 // Buttons
 function RegisterCustomBitBtn: Boolean; alias : 'WSRegisterCustomBitBtn';
 begin
-  Result := False;
+  RegisterWSComponent(TCustomBitBtn, TCocoaWSBitBtn);
+  Result := True;
 end;
 
 function RegisterCustomSpeedButton: Boolean; alias : 'WSRegisterCustomSpeedButton';

lcl/interfaces/lcl.lpk

@@ -110,7 +110,7 @@ end;"/>
     <License Value="modified LGPL-2
 "/>
     <Version Major="1" Release="1"/>
-    <Files Count="334">
+    <Files Count="335">
       <Item1>
         <Filename Value="android/androidint.pas"/>
         <AddToUsesPkgSection Value="False"/>
@@ -1668,6 +1668,10 @@ end;"/>
         <Filename Value="qt/qtx11.inc"/>
         <Type Value="Include"/>
       </Item334>
+      <Item335>
+        <Filename Value="cocoa/cocoawsbuttons.pp"/>
+        <UnitName Value="cocoawsbuttons"/>
+      </Item335>
     </Files>
     <LazDoc Paths="../../docs/xml/lcl"/>
     <i18n>

lcl/interfaces/lcl.pas

@@ -7,7 +7,7 @@ unit LCL;
 interface
 
 uses
-  AllLCLIntfUnits, LazarusPackageIntf;
+  AllLCLIntfUnits, cocoawsbuttons, LazarusPackageIntf;
 
 implementation