lazarus/lcl/interfaces/cocoa/cocoawsbuttons.pp

{
 *****************************************************************************
 *                              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+}
{$modeswitch objectivec1}

interface

uses
  // libs
  MacOSAll, CocoaAll,
  // LCL
  Classes, Controls, Buttons, LCLType, LCLProc, Graphics, GraphType,
  // widgetset
  WSButtons, WSLCLClasses, WSProc,
  // LCL Carbon
  CocoaWSCommon, CocoaWSStdCtrls, CocoaGDIObjects, CocoaUtils;

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;
var
  btn: NSButton;
begin
  btn := AllocButton(AWinControl, TLCLButtonCallBack, AParams, NSRoundedBezelStyle, NSMomentaryPushInButton);
  Result := TLCLIntfHandle(btn);
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: NSImage;
  AGlyph: TBitmap;
  AIndex: Integer;
  AEffect: TGraphicsDrawEffect;
begin
  Img := nil;
  if ABitBtn.CanShowGlyph then
  begin
    AGlyph := TBitmap.Create;
    AValue.GetImageIndexAndEffect(bsUp, AIndex, AEffect);
    AValue.Images.GetBitmap(AIndex, AGlyph, AEffect);
    Img := TCocoaBitmap(AGlyph.Handle).image;
    NSButton(ABitBtn.Handle).setImage(Img);
    AGlyph.Free;
  end;
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
  ImagePosition: NSCellImagePosition;
begin

  if (ABitBtn.CanShowGlyph) then
  begin
    case AValue of
      blGlyphLeft  : ImagePosition := NSImageLeft;
      blGlyphRight : ImagePosition := NSImageRight;
      blGlyphTop   : ImagePosition := NSImageBelow;
      blGlyphBottom: ImagePosition := NSImageAbove;
    end;
  end
  else
    ImagePosition := NSNoImage;
  NSButton(ABitBtn.Handle).SetImagePosition(ImagePosition);
end;

end.