1 {
2  *****************************************************************************
3  *                              CocoaWSButtons.pp                            *
4  *                              --------------                               *
5  *                                                                           *
6  *                                                                           *
7  *****************************************************************************
8 
9  *****************************************************************************
10   This file is part of the Lazarus Component Library (LCL)
11 
12   See the file COPYING.modifiedLGPL.txt, included in this distribution,
13   for details about the license.
14  *****************************************************************************
15 }
16 unit cocoawsbuttons;
17 
18 {$mode objfpc}{$H+}
19 {$modeswitch objectivec1}
20 
21 interface
22 
23 uses
24   // libs
25   MacOSAll, CocoaAll, SysUtils, Math,
26   // LCL
27   Classes, Controls, Buttons, LCLType, LCLProc, Graphics, GraphType, ImgList,
28   // widgetset
29   WSButtons, WSLCLClasses, WSProc,
30   // LCL Cocoa
31   CocoaWSCommon, CocoaWSStdCtrls, CocoaGDIObjects, CocoaPrivate, CocoaUtils,
32   cocoa_extra, CocoaButtons;
33 
34 type
35 
36   { TCocoaWSBitBtn }
37 
38   TCocoaWSBitBtn = class(TWSBitBtn)
39   private
LCLGlyphPosToCocoanull40     class function  LCLGlyphPosToCocoa(ALayout: TButtonLayout): NSCellImagePosition;
41   published
CreateHandlenull42     class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
43     //
44     class procedure GetPreferredSize(const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
45     //
46     class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
47     class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override;
48   end;
49 
50   { TCocoaWSSpeedButton }
51 
52   TCocoaWSSpeedButton = class(TWSSpeedButton)
53   published
54   end;
55 
56 
57 implementation
58 
59 { TCocoaWSBitBtn }
60 
TCocoaWSBitBtn.LCLGlyphPosToCocoanull61 class function TCocoaWSBitBtn.LCLGlyphPosToCocoa(ALayout: TButtonLayout
62   ): NSCellImagePosition;
63 begin
64   case ALayout of
65   blGlyphLeft:   Result := NSImageLeft;
66   blGlyphRight:  Result := NSImageRight;
67   blGlyphTop:    Result := NSImageAbove;
68   blGlyphBottom: Result := NSImageBelow;
69   else
70     Result := NSNoImage;
71   end;
72 end;
73 
74 {------------------------------------------------------------------------------
75   Method:  TCocoaWSBitBtn.CreateHandle
76   Params:  AWinControl - LCL control
77            AParams     - Creation parameters
78   Returns: Handle to the control in Carbon interface
79 
80   Creates new bevel button with bitmap in Cocoa interface with the
81   specified parameters
82  ------------------------------------------------------------------------------}
TCocoaWSBitBtn.CreateHandlenull83 class function TCocoaWSBitBtn.CreateHandle(const AWinControl: TWinControl;
84   const AParams: TCreateParams): TLCLIntfHandle;
85 var
86   btn: NSButton;
87 begin
88   btn := AllocButton(AWinControl, TLCLButtonCallBack, AParams, NSRegularSquareBezelStyle, NSMomentaryPushInButton);
89   Result := TLCLIntfHandle(btn);
90 end;
91 
92 class procedure TCocoaWSBitBtn.GetPreferredSize(const AWinControl: TWinControl;
93   var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
94 var
95   lButton: TCustomBitBtn absolute AWinControl;
96   lButtonHandle: TCocoaButton;
97   Size: NSSize;
98 begin
99   if not AWinControl.HandleAllocated then Exit;
100 
101   lButtonHandle := TCocoaButton(AWinControl.Handle);
102   // fittingSize is 10.7+
103   if lButtonHandle.respondsToSelector(objcselector('fittingSize')) then
104   begin
105     Size := lButtonHandle.fittingSize();
106     if lButton.Glyph <> nil then
107       Size.Height := Max(Size.Height, lButton.Glyph.Height + 6); // This nr is arbitrary
108     PreferredWidth := Round(Size.Width);
109     PreferredHeight := Round(Size.Height);
110   end;
111 end;
112 
113 {------------------------------------------------------------------------------
114   Method:  TCocoaWSBitBtn.SetGlyph
115   Params:  ABitBtn - LCL custom bitmap button
116            AValue  - Bitmap
117 
118   Sets the bitmap of bevel button in Cocoa interface
119  ------------------------------------------------------------------------------}
120 class procedure TCocoaWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph);
121 var
122   Img: NSImage;
123   AGlyph: TBitmap;
124   lButtonHandle: TCocoaButton;
125   AIndex: Integer;
126   AEffect: TGraphicsDrawEffect;
127   AImgRes: TScaledImageListResolution;
128   ImgSize: NSSize;
129   ScaleFactor: Double;
130 begin
131   //WriteLn('[TCocoaWSBitBtn.SetGlyph]');
132   Img := nil;
133   if ABitBtn.CanShowGlyph(True) then
134   begin
135     AGlyph := TBitmap.Create;
136     ScaleFactor := ABitBtn.GetCanvasScaleFactor;
137     AValue.GetImageIndexAndEffect(bsUp, ABitBtn.Font.PixelsPerInch,
138       ScaleFactor, AImgRes, AIndex, AEffect);
139     AImgRes.GetBitmap(AIndex, AGlyph, AEffect);
140     Img := TCocoaBitmap(AGlyph.Handle).image;
141     if AImgRes.Resolution.ImageList.Scaled and not SameValue(ScaleFactor, 1) then // resize only if the image list is scaled
142     begin
143       ImgSize := Img.size;
144       ImgSize.height := ImgSize.height / ScaleFactor;
145       ImgSize.width := ImgSize.width / ScaleFactor;
146       Img.setSize(ImgSize);
147     end;
148     lButtonHandle := TCocoaButton(ABitBtn.Handle);
149     lButtonHandle.setImage(Img);
150     lButtonHandle.setImagePosition(LCLGlyphPosToCocoa(ABitBtn.Layout));
151     lButtonHandle.setImageScaling(NSImageScaleNone); // do not scale - retina scaling is done above with Img.setSize
152     if Assigned(lButtonHandle.Glyph) then
153       FreeAndNil(lButtonHandle.Glyph);
154     lButtonHandle.Glyph := AGlyph;
155   end;
156 end;
157 
158 {------------------------------------------------------------------------------
159   Method:  TCocoaWSBitBtn.SetLayout
160   Params:  ABitBtn - LCL custom bitmap button
161            AValue  - Bitmap and caption layout
162 
163   Sets the bitmap and caption layout of bevel button in Cocoa interface
164  ------------------------------------------------------------------------------}
165 class procedure TCocoaWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
166   const AValue: TButtonLayout);
167 var
168   ImagePos: NSCellImagePosition;
169 begin
170 
171   if ABitBtn.CanShowGlyph(True) then
172     ImagePos := LCLGlyphPosToCocoa(AValue)
173   else
174     ImagePos := NSNoImage;
175   NSButton(ABitBtn.Handle).SetImagePosition(ImagePos);
176 end;
177 
178 end.
179