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