1 { $Id: $}
2 { --------------------------------------------
3 cocoabuttons.pas - Cocoa internal classes
4 --------------------------------------------
5
6 This unit contains the private classhierarchy for the Cocoa implemetations
7
8 *****************************************************************************
9 This file is part of the Lazarus Component Library (LCL)
10
11 See the file COPYING.modifiedLGPL.txt, included in this distribution,
12 for details about the license.
13 *****************************************************************************
14 }
15 unit CocoaButtons;
16
17 {$mode objfpc}{$H+}
18 {$modeswitch objectivec1}
19 {$modeswitch objectivec2}
20 {$interfaces corba}
21 {$include cocoadefines.inc}
22
23 interface
24
25 uses
26 // rtl+ftl
27 Types, Classes, SysUtils,
28 CGGeometry,
29 // Libs
30 MacOSAll, CocoaAll, CocoaUtils, CocoaGDIObjects,
31 cocoa_extra, CocoaPrivate
32 // LCL
33 ,Graphics;
34
35 const
36 // these heights were received from Xcode interface builder,
37 // where the height cannot be changed for a button control the actual size
38 // of the button (the difference between top pixel and bottom pixel,
39 // is less than frame size also
40
41 PUSHBTN_REG_HEIGHT = 20;
42 PUSHBTN_SMALL_HEIGHT = 17;
43 PUSHBTN_MINI_HEIGHT = 14;
44
45
46 type
47
48 { IButtonCallback }
49
50 IButtonCallback = interface(ICommonCallback)
51 procedure ButtonClick;
52 procedure GetAllowMixedState(var allowed: Boolean);
53 end;
54
55
56 { TCocoaButton }
57
58 TCocoaButton = objcclass(NSButton)
59 protected
60 procedure actionButtonClick(sender: NSObject); message 'actionButtonClick:';
61 procedure boundsDidChange(sender: NSNotification); message 'boundsDidChange:';
62 procedure frameDidChange(sender: NSNotification); message 'frameDidChange:';
63 public
64 callback: IButtonCallback;
65 Glyph: TBitmap;
66
67 smallHeight: integer;
68 miniHeight: integer;
69 adjustFontToControlSize: Boolean;
70 procedure dealloc; override;
initWithFramenull71 function initWithFrame(frameRect: NSRect): id; override;
acceptsFirstRespondernull72 function acceptsFirstResponder: LCLObjCBoolean; override;
73 procedure drawRect(dirtyRect: NSRect); override;
lclGetCallbacknull74 function lclGetCallback: ICommonCallback; override;
75 procedure lclClearCallback; override;
76 // keyboard
77 procedure keyDown(event: NSEvent); override;
performKeyEquivalentnull78 function performKeyEquivalent(event: NSEvent): LCLObjCBoolean; override;
79
80 // mouse
81 procedure mouseDown(event: NSEvent); override;
82 procedure mouseUp(event: NSEvent); override;
83 procedure rightMouseDown(event: NSEvent); override;
84 procedure rightMouseUp(event: NSEvent); override;
85 procedure otherMouseDown(event: NSEvent); override;
86 procedure otherMouseUp(event: NSEvent); override;
87
88 procedure mouseDragged(event: NSEvent); override;
89 procedure mouseEntered(event: NSEvent); override;
90 procedure mouseExited(event: NSEvent); override;
91 procedure mouseMoved(event: NSEvent); override;
92 procedure resetCursorRects; override;
93 // lcl overrides
94 procedure lclSetFrame(const r: TRect); override;
95 procedure lclCheckMixedAllowance; message 'lclCheckMixedAllowance';
lclGetFrameToLayoutDeltanull96 function lclGetFrameToLayoutDelta: TRect; override;
97 // cocoa
98 procedure setState(astate: NSInteger); override;
99 end;
100
101
102 IStepperCallback = interface(ICommonCallback)
103 procedure BeforeChange(var Allowed: Boolean);
104 procedure Change(NewValue: Double; isUpPressed: Boolean; var Allowed: Boolean);
105 procedure UpdownClick(isUpPressed: Boolean);
106 end;
107
108 { TCocoaStepper }
109
110 TCocoaStepper = objcclass(NSStepper)
111 callback: IStepperCallback;
112 lastValue: Double;
113 procedure stepperAction(sender: NSObject); message 'stepperAction:';
114
115 procedure mouseDown(event: NSEvent); override;
116 procedure mouseUp(event: NSEvent); override;
117 procedure rightMouseDown(event: NSEvent); override;
118 procedure rightMouseUp(event: NSEvent); override;
119 procedure otherMouseDown(event: NSEvent); override;
120 procedure otherMouseUp(event: NSEvent); override;
121
122 procedure mouseDragged(event: NSEvent); override;
123 procedure mouseMoved(event: NSEvent); override;
124 end;
125
126 implementation
127
128 { TCocoaStepper }
129
130 procedure TCocoaStepper.stepperAction(sender: NSObject);
131 var
132 newval : Double;
133 allowChange : Boolean;
134 updownpress : Boolean;
135 begin
136 newval := doubleValue;
137 allowChange := true;
138 updownpress := newval > lastValue;
139
140 if Assigned(callback) then begin
141 callback.BeforeChange(allowChange);
142 callback.Change(newval, updownpress, allowChange);
143 end;
144
145 if not allowChange then
146 setDoubleValue(lastValue)
147 else
148 lastValue := doubleValue;
149
150 if Allowchange and Assigned(callback) then callback.UpdownClick(updownpress);
151 end;
152
153 procedure TCocoaStepper.mouseDown(event: NSEvent);
154 begin
155 if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
156 begin
157 inherited mouseDown(event);
158 if Assigned(Callback) then
159 callback.MouseUpDownEvent(event, true);
160 end;
161 end;
162
163 procedure TCocoaStepper.mouseUp(event: NSEvent);
164 begin
165 if not callback.MouseUpDownEvent(event) then
166 inherited mouseUp(event);
167 end;
168
169 procedure TCocoaStepper.rightMouseDown(event: NSEvent);
170 begin
171 if not callback.MouseUpDownEvent(event) then
172 inherited rightMouseDown(event);
173 end;
174
175 procedure TCocoaStepper.rightMouseUp(event: NSEvent);
176 begin
177 if not callback.MouseUpDownEvent(event) then
178 inherited rightMouseUp(event);
179 end;
180
181 procedure TCocoaStepper.otherMouseDown(event: NSEvent);
182 begin
183 if not callback.MouseUpDownEvent(event) then
184 inherited otherMouseDown(event);
185 end;
186
187 procedure TCocoaStepper.otherMouseUp(event: NSEvent);
188 begin
189 if not callback.MouseUpDownEvent(event) then
190 inherited otherMouseUp(event);
191 end;
192
193 procedure TCocoaStepper.mouseDragged(event: NSEvent);
194 begin
195 if not callback.MouseMove(event) then
196 inherited mouseDragged(event);
197 end;
198
199 procedure TCocoaStepper.mouseMoved(event: NSEvent);
200 begin
201 if not callback.MouseMove(event) then
202 inherited mouseMoved(event);
203 end;
204
205 { TCocoaButton }
206
207 procedure TCocoaButton.lclSetFrame(const r: TRect);
208 var
209 lBtnHeight, lDiff: Integer;
210 lRoundBtnSize: NSSize;
211 begin
212 // NSTexturedRoundedBezelStyle should be the preferred style, but it has a fixed height!
213 // fittingSize is 10.7+
214 { if respondsToSelector(objcselector('fittingSize')) then
215 begin
216 lBtnHeight := r.Bottom - r.Top;
217 lRoundBtnSize := fittingSize();
218 lDiff := Abs(Round(lRoundBtnSize.Height) - lBtnHeight);
219 if lDiff < 4 then // this nr of pixels maximum size difference is arbitrary and we could choose another number
220 setBezelStyle(NSTexturedRoundedBezelStyle)
221 else
222 setBezelStyle(NSTexturedSquareBezelStyle);
223 end
224 else
225 setBezelStyle(NSTexturedSquareBezelStyle);
226 }
227 if (miniHeight<>0) or (smallHeight<>0) then
228 SetNSControlSize(Self,r.Bottom-r.Top,miniHeight, smallHeight, adjustFontToControlSize);
229 inherited lclSetFrame(r);
230 end;
231
232 procedure TCocoaButton.lclCheckMixedAllowance;
233 var
234 allowed : Boolean;
235 begin
236 if allowsMixedState and Assigned(callback) then begin
237 allowed := false;
238 callback.GetAllowMixedState(allowed);
239 if not allowed then begin
240 // "mixed" should be following by "On" state
241 // lclCheckMixedAllowance is called prior to changing
242 // the state. So the state needs to be switched to "Off"
243 // so it could be then switched to "On" by Cocoa
244 if state = NSMixedState then
245 inherited setState(NSOffState);
246 {$ifdef BOOLFIX}
247 setAllowsMixedState_(Ord(false));
248 {$else}
249 setAllowsMixedState(false);
250 {$endif}
251 end;
252 end;
253 end;
254
lclGetFrameToLayoutDeltanull255 function TCocoaButton.lclGetFrameToLayoutDelta: TRect;
256 begin
257 case bezelStyle of
258 NSPushOnPushOffButton:
259 begin
260 // todo: on 10.7 or later there's a special API for that!
261 // The data is received from 10.6 Interface Builder
262 case NSCell(Self.Cell).controlSize of
263 NSSmallControlSize: begin
264 Result.Left := 5;
265 Result.Top := 4;
266 Result.Right := -5;
267 Result.Bottom := -7;
268 end;
269 NSMiniControlSize: begin
270 Result.Left := 1;
271 Result.Top := 0;
272 Result.Right := -1;
273 Result.Bottom := -2;
274 end;
275 else
276 // NSRegularControlSize
277 Result.Left := 6;
278 Result.Top := 4;
279 Result.Right := -6;
280 Result.Bottom := -8;
281 end;
282 end;
283 else
284 Result := inherited lclGetFrameToLayoutDelta;
285 end;
286 end;
287
288 procedure TCocoaButton.setState(astate: NSInteger);
289 var
290 ch : Boolean;
291 begin
292 ch := astate<>state;
293 inherited setState(astate);
294 if Assigned(callback) and ch then callback.SendOnChange;
295 end;
296
297 procedure TCocoaButton.actionButtonClick(sender: NSObject);
298 begin
299 // this is the action handler of button
300 if Assigned(callback) then
301 callback.ButtonClick;
302 end;
303
304 procedure TCocoaButton.boundsDidChange(sender: NSNotification);
305 begin
306 if Assigned(callback) then
307 callback.boundsDidChange(self);
308 end;
309
310 procedure TCocoaButton.frameDidChange(sender: NSNotification);
311 begin
312 if Assigned(callback) then
313 callback.frameDidChange(self);
314 end;
315
316 procedure TCocoaButton.dealloc;
317 begin
318 if Assigned(Glyph) then
319 FreeAndNil(Glyph);
320
321 inherited dealloc;
322 end;
323
initWithFramenull324 function TCocoaButton.initWithFrame(frameRect: NSRect): id;
325 begin
326 Result := inherited initWithFrame(frameRect);
327 if Assigned(Result) then
328 begin
329 setTarget(Self);
330 setAction(objcselector('actionButtonClick:'));
331 // todo: find a way to release notifications below
332 // NSNotificationCenter.defaultCenter.addObserver_selector_name_object(Self, objcselector('boundsDidChange:'), NSViewBoundsDidChangeNotification, Result);
333 // NSNotificationCenter.defaultCenter.addObserver_selector_name_object(Self, objcselector('frameDidChange:'), NSViewFrameDidChangeNotification, Result);
334 // Result.setPostsBoundsChangedNotifications(True);
335 // Result.setPostsFrameChangedNotifications(True);
336 end;
337 end;
338
acceptsFirstRespondernull339 function TCocoaButton.acceptsFirstResponder: LCLObjCBoolean;
340 begin
341 Result := True;
342 end;
343
344 procedure TCocoaButton.drawRect(dirtyRect: NSRect);
345 var ctx: NSGraphicsContext;
346 begin
347 inherited drawRect(dirtyRect);
348 if CheckMainThread and Assigned(callback) then
349 callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
350 end;
351
lclGetCallbacknull352 function TCocoaButton.lclGetCallback: ICommonCallback;
353 begin
354 Result := callback;
355 end;
356
357 procedure TCocoaButton.lclClearCallback;
358 begin
359 callback := nil;
360 end;
361
362 procedure TCocoaButton.keyDown(event: NSEvent);
363 begin
364 if event.keyCode = kVK_Space then
365 lclCheckMixedAllowance;
366 inherited keyDown(event);
367 end;
368
performKeyEquivalentnull369 function TCocoaButton.performKeyEquivalent(event: NSEvent): LCLObjCBoolean;
370 begin
371 // "Return" is a keyEquivalent for a "default" button"
372 // LCL provides its own mechanism for handling default buttons
373 if (keyEquivalent.length = 1) and (keyEquivalentModifierMask = 0) and
374 (keyEquivalent.characterAtIndex(0) = NSCarriageReturnCharacter) then
375 Result := False
376 else
377 Result := inherited performKeyEquivalent(event);
378 end;
379
380 procedure TCocoaButton.mouseUp(event: NSEvent);
381 begin
382 if not callback.MouseUpDownEvent(event) then
383 inherited mouseUp(event);
384 end;
385
386 procedure TCocoaButton.rightMouseDown(event: NSEvent);
387 begin
388 if not callback.MouseUpDownEvent(event) then
389 inherited rightMouseDown(event);
390 end;
391
392 procedure TCocoaButton.rightMouseUp(event: NSEvent);
393 begin
394 if not callback.MouseUpDownEvent(event) then
395 inherited rightMouseUp(event);
396 end;
397
398 procedure TCocoaButton.otherMouseDown(event: NSEvent);
399 begin
400 if not callback.MouseUpDownEvent(event) then
401 inherited otherMouseDown(event);
402 end;
403
404 procedure TCocoaButton.otherMouseUp(event: NSEvent);
405 begin
406 if not callback.MouseUpDownEvent(event) then
407 inherited otherMouseUp(event);
408 end;
409
410 procedure TCocoaButton.resetCursorRects;
411 begin
412 if not callback.resetCursorRects then
413 inherited resetCursorRects;
414 end;
415
416 procedure TCocoaButton.mouseDown(event: NSEvent);
417 begin
418 if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
419 begin
420 lclCheckMixedAllowance;
421 // We need to call the inherited regardless of the result of the call to
422 // MouseUpDownEvent otherwise mouse clicks don't work, see bug 30131
423 inherited mouseDown(event);
424 if Assigned(callback) then
425 callback.MouseUpDownEvent(event, true);
426 end;
427 end;
428
429 procedure TCocoaButton.mouseDragged(event: NSEvent);
430 begin
431 if not callback.MouseMove(event) then
432 inherited mouseDragged(event);
433 end;
434
435 procedure TCocoaButton.mouseEntered(event: NSEvent);
436 begin
437 inherited mouseEntered(event);
438 end;
439
440 procedure TCocoaButton.mouseExited(event: NSEvent);
441 begin
442 inherited mouseExited(event);
443 end;
444
445 procedure TCocoaButton.mouseMoved(event: NSEvent);
446 begin
447 if not callback.MouseMove(event) then
448 inherited mouseMoved(event);
449 end;
450
451 end.
452
453