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 176 177 178
|
{
*****************************************************************************
* 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, WSProc,
// LCL Cocoa
CocoaWSCommon, CocoaWSStdCtrls, CocoaGDIObjects, CocoaPrivate, CocoaUtils,
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): TLCLIntfHandle; 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): TLCLIntfHandle;
var
btn: NSButton;
begin
btn := AllocButton(AWinControl, TLCLButtonCallBack, AParams, NSRegularSquareBezelStyle, NSMomentaryPushInButton);
Result := TLCLIntfHandle(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);
// fittingSize is 10.7+
if lButtonHandle.respondsToSelector(objcselector('fittingSize')) then
begin
Size := lButtonHandle.fittingSize();
if lButton.Glyph <> nil then
Size.Height := Max(Size.Height, lButton.Glyph.Height + 6); // This nr is arbitrary
PreferredWidth := Round(Size.Width);
PreferredHeight := Round(Size.Height);
end;
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.
|