1 unit CocoaUtils;
2
3 {$mode objfpc}{$H+}
4 {$modeswitch objectivec1}
5
6 interface
7
8 uses
9 classes,
10 MacOSAll, CocoaAll, Cocoa_Extra,
11 SysUtils, Types, LCLType, LCLClasses, LCLProc,
12 Graphics, Math, GraphType;
13
14 var
15 // post message/send message string. Created by TCocoaWidgetSet
16 NSMessageWnd, NSMessageMsg, NSMessageWParam, NSMessageLParam, NSMessageResult: NSString;
17
18 type
19 { NSLCLDebugExtension }
20
21 NSLCLDebugExtension = objccategory(NSObject)
lclClassNamenull22 function lclClassName: shortstring; message 'lclClassName';
23 end;
24
25 const
26 NSNullRect : NSRect = (origin:(x:0; y:0); size:(width:0; height:0));
27
GetNSSizenull28 function GetNSSize(width, height: CGFloat): NSSize; inline;
29
GetNSPointnull30 function GetNSPoint(x,y: single): NSPoint; inline;
LCLToNSPointnull31 function LCLToNSPoint(APt: TPoint; ParentHeight: Single): NSPoint;
32
GetCGRectnull33 function GetCGRect(x1, y1, x2, y2: Integer): CGRect; inline;
GetCGRectSortednull34 function GetCGRectSorted(X1, Y1, X2, Y2: Integer): CGRect;
RectToCGRectnull35 function RectToCGRect(const R: TRect): CGRect;
CGRectToRectnull36 function CGRectToRect(const c: CGRect): TRect;
37
GetNSRectnull38 function GetNSRect(x, y, width, height: Integer): NSRect; inline;
RectToNSRectnull39 function RectToNSRect(const r: TRect): NSRect;
NSRectToRectnull40 function NSRectToRect(const NS: NSRect): TRect;
41
42 procedure NSToLCLRect(const ns: NSRect; ParentHeight: Single; out lcl: TRect);
43 procedure LCLToNSRect(const lcl: TRect; ParentHeight: Single; out ns: NSRect);
44
NSScreenZeroHeightnull45 function NSScreenZeroHeight: CGFloat;
46
CreateParamsToNSRectnull47 function CreateParamsToNSRect(const params: TCreateParams): NSRect;
48
NSStringUtf8null49 function NSStringUtf8(s: PChar): NSString;
NSStringUtf8null50 function NSStringUtf8(const s: String): NSString;
NSStringToStringnull51 function NSStringToString(ns: NSString): String;
52
GetNSObjectWindownull53 function GetNSObjectWindow(obj: NSObject): NSWindow;
54
55 procedure SetNSText(text: NSText; const s: String); inline;
GetNSTextnull56 function GetNSText(text: NSText): string; inline;
57
58 procedure SetNSControlValue(c: NSControl; const S: String); inline;
GetNSControlValuenull59 function GetNSControlValue(c: NSControl): String; inline;
60
61 procedure ColorToRGBFloat(cl: TColorRef; var r,g,b: Single); inline;
RGBToColorFloatnull62 function RGBToColorFloat(r,g,b: Single): TColorRef; inline;
63 // extract ColorRef from NSColor in RGB colorspace
NSColorToRGBnull64 function NSColorToRGB(const Color: NSColor): TColorRef; inline;
65 // extract ColorRef from any NSColor
NSColorToColorRefnull66 function NSColorToColorRef(const Color: NSColor): TColorRef;
ColorToNSColornull67 function ColorToNSColor(const Color: TColorRef): NSColor; inline;
68 // convert to known NSColor or nil
SysColorToNSColornull69 function SysColorToNSColor(nIndex: Integer): NSColor;
70
71 // "dark" is not a good reference, as Apple might add more and more themes
IsDarkPossiblenull72 function IsDarkPossible: Boolean; inline;
73
74 // returns if the application appearance is set to dark
IsAppDarknull75 function IsAppDark: Boolean;
76
77 // returns if the window appearance is set to dark
IsWinDarknull78 function IsWinDark(win: NSWindow): Boolean;
79
80 // Returns the appearance object that is active on the current thread.
81 // returns true, if currently drawn (Painted) UI control is in Dark theme.
IsPaintDarknull82 function IsPaintDark: Boolean;
83
84 // returns true, if Appear is assigned and bears name of Dark theme
IsAppearDarknull85 function IsAppearDark(Appear: NSAppearance): Boolean; inline;
86
87 // weak-referenced NSAppearnceClass. Returns nil on any OS prior to 10.13
NSAppearanceClassnull88 function NSAppearanceClass: pobjc_class;
89
90 const
91 DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
92
CFStringToStrnull93 function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): String;
CFStringToStringnull94 function CFStringToString(AString: CFStringRef): String;
95
96 // Missing things from NSTableColumns.inc
97 const
98 NSTableColumnAutoresizingMask = 1 shl 0;
99 NSTableColumnUserResizingMask = 1 shl 1;
100
VirtualKeyCodeToMacStringnull101 function VirtualKeyCodeToMacString(AKey: Word): NSString;
102
103 procedure FillStandardDescription(out Desc: TRawImageDescription);
104
105 procedure CreateCFString(const S: String; out AString: CFStringRef);
106 procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out AString: CFStringRef);
107 procedure FreeCFString(var AString: CFStringRef);
CFStringToDatanull108 function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): CFDataRef;
109
GetCurrentEventTimenull110 function GetCurrentEventTime: double;
GetMacOSXVersionnull111 function GetMacOSXVersion: Integer;
112
DateTimeToNSDatenull113 function DateTimeToNSDate(const aDateTime : TDateTime): NSDate;
NSDateToDateTimenull114 function NSDateToDateTime(const aDateTime: NSDate): TDateTime;
115
removesnull116 // The function removes single & and replaced && with &
117 // (removing LCL (Windows) specific caption convention
118 function ControlTitleToStr(const ATitle: string): String;
119 // The returned NSString doesn't require a release
120 // (it would happen in NSAutoRelease pool)
121 function ControlTitleToNSStr(const ATitle: string): NSString;
122
123 procedure AddLayoutToFrame(const layout: TRect; var frame: TRect);
124 procedure SubLayoutFromFrame(const layout: TRect; var frame: TRect);
125
126 // MacOSX Virtual Key Codes missing from MacOSAll.Events.pas
127 const
128 kVK_SubMenu = $6E;
129
130 function MacCodeToVK(AKey: Word): Word;
131
132 function MacCharToVK(achar: unichar): Word;
133
134 procedure ApplicationWillShowModal;
135
136 const
137 // Shift, Control, Alt and Command
138 KeysModifiers = NSShiftKeyMask or NSControlKeyMask or NSAlternateKeyMask or NSCommandKeyMask;
139
140 function NSEventRawKeyChar(ev: NSEvent): System.WideChar;
141
142 function AllocImageRotatedByDegrees(src: NSImage; degrees: double): NSImage;
143 function AllocCursorFromCursorByDegrees(src: NSCursor; degrees: double): NSCursor;
144
145 type
146
147 { TCocoaInputClient }
148
149 TCocoaInputClient = objcclass(NSObject, NSTextInputClientProtocol)
150 procedure insertText_replacementRange(aString: id; replacementRange: NSRange);
151 procedure setMarkedText_selectedRange_replacementRange(aString: id; selectedRange: NSRange; replacementRange: NSRange);
152 procedure unmarkText;
153 function selectedRange: NSRange;
154 function markedRange: NSRange;
155 function hasMarkedText: LCLObjCBoolean;
156 function attributedSubstringForProposedRange_actualRange(aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
157 function validAttributesForMarkedText: NSArray;
158 function firstRectForCharacterRange_actualRange(aRange: NSRange; actualRange: NSRangePointer): NSRect;
159 function characterIndexForPoint(aPoint: NSPoint): NSUInteger;
160
161 procedure doCommandBySelector(asel: sel); message 'doCommandBySelector:';
162 end;
163
164 implementation
165
166 procedure ApplicationWillShowModal;
167 begin
168 // Any place that would attempt to use Cocoa-native modality.
169 // should call this routine, prior to the call
170 // This is a workaround for AppKit drawing approaches
171
172 // hack: it's assumed that an implicit transaction is running at the moment
173 // for versions 10.7 and later it's possible to add an end-transacion
174 // block. But since blocks are not yet, if official FPC release
175 // the approach is not used
176 //
177 // the code takes care of all modal windows
178 //
179 // The hack is commented out, as it doesn't work on some machines
180
181 //if NSAppkitversionNumber >= NSAppKitVersionNumber10_12 then
182 //NSAnimationContext.endGrouping;
183
184 // If transaction is not terminated by calling "endGrouping"
185 // the typical error shown is:
186 //
187 // *** Terminating app due to uncaught exception 'NSGenericException',
188 // reason: '-[NSApplication runModalForWindow:] may not be invoked
189 // inside of transaction begin/commit pair, or inside of transaction
190 // commit (usually this means it was invoked inside of a view's -drawRect: method.)'
191 // terminating with uncaught exception of type NSException
192 // abort() called
193 end;
194
195 function MacCodeToVK(AKey: Word): Word;
196 begin
197 case AKey of
198 kVK_ANSI_A : Result := VK_A;
199 kVK_ANSI_S : Result := VK_S;
200 kVK_ANSI_D : Result := VK_D;
201 kVK_ANSI_F : Result := VK_F;
202 kVK_ANSI_H : Result := VK_H;
203 kVK_ANSI_G : Result := VK_G;
204 kVK_ANSI_Z : Result := VK_Z;
205 kVK_ANSI_X : Result := VK_X;
206 kVK_ANSI_C : Result := VK_C;
207 kVK_ANSI_V : Result := VK_V;
208
209 //kVK_ISO_Section // ISO keyboard only
210
211 kVK_ANSI_B : Result := VK_B;
212 kVK_ANSI_Q : Result := VK_Q;
213 kVK_ANSI_W : Result := VK_W;
214 kVK_ANSI_E : Result := VK_E;
215 kVK_ANSI_R : Result := VK_R;
216 kVK_ANSI_Y : Result := VK_Y;
217 kVK_ANSI_T : Result := VK_T;
218 kVK_ANSI_1 : Result := VK_1;
219 kVK_ANSI_2 : Result := VK_2;
220 kVK_ANSI_3 : Result := VK_3;
221 kVK_ANSI_4 : Result := VK_4;
222 kVK_ANSI_6 : Result := VK_6;
223 kVK_ANSI_5 : Result := VK_5;
224 kVK_ANSI_Equal : Result := VK_LCL_EQUAL; // aka VK_EQUAL = 187 = $BB;
225 kVK_ANSI_9 : Result := VK_9;
226 kVK_ANSI_7 : Result := VK_7;
227 kVK_ANSI_Minus : Result := VK_OEM_MINUS;
228 kVK_ANSI_8 : Result := VK_8;
229 kVK_ANSI_0 : Result := VK_0;
230 kVK_ANSI_RightBracket : Result := VK_OEM_6;
231 kVK_ANSI_O : Result := VK_O;
232 kVK_ANSI_U : Result := VK_U;
233 kVK_ANSI_LeftBracket : Result := VK_LCL_OPEN_BRAKET;
234 kVK_ANSI_I : Result := VK_I;
235 kVK_ANSI_P : Result := VK_P;
236
237 kVK_Return : Result := VK_RETURN;
238
239 kVK_ANSI_L : Result := VK_L;
240 kVK_ANSI_J : Result := VK_J;
241 kVK_ANSI_Quote : Result := VK_LCL_QUOTE;
242 kVK_ANSI_K : Result := VK_K;
243 kVK_ANSI_Semicolon : Result := VK_LCL_SEMI_COMMA;
244 kVK_ANSI_Backslash : Result := VK_LCL_BACKSLASH;
245 kVK_ANSI_Comma : Result := VK_LCL_COMMA;
246 kVK_ANSI_Slash : Result := VK_LCL_SLASH;
247 kVK_ANSI_N : Result := VK_N;
248 kVK_ANSI_M : Result := VK_M;
249 kVK_ANSI_Period : Result := VK_LCL_POINT;
250
251 kVK_Tab : Result := VK_TAB;
252 kVK_Space : Result := VK_SPACE;
253
254 kVK_ANSI_Grave : Result := VK_LCL_TILDE;
255
256 kVK_Delete : Result := VK_BACK; // or VK_DELETE?
257
258 kVK_Escape : Result := VK_ESCAPE;
259 kVK_Command : Result := VK_LWIN;
260 // todo: Application.ExtendedKeysSupport must be true!
261 kVK_Shift : Result := VK_LSHIFT; // VK_SHIFT?
262 kVK_CapsLock : Result := VK_CAPITAL;
263 kVK_Option : Result := VK_LMENU;
264 kVK_Control : Result := VK_LCONTROL;
265 kVK_RightShift : Result := VK_RSHIFT;
266 kVK_RightOption : Result := VK_RMENU;
267 kVK_RightControl : Result := VK_RCONTROL;
268 //kVK_Function : Result := VK_; todo:
269 kVK_F17 : Result := VK_F17;
270
271 kVK_ANSI_KeypadDecimal : Result := VK_DECIMAL;
272 kVK_ANSI_KeypadMultiply : Result := VK_MULTIPLY;
273 kVK_ANSI_KeypadPlus : Result := VK_ADD;
274 kVK_ANSI_KeypadClear : Result := VK_NUMLOCK;
275
276 kVK_VolumeUp : Result := VK_VOLUME_UP;
277 kVK_VolumeDown : Result := VK_VOLUME_DOWN;
278 kVK_Mute : Result := VK_VOLUME_MUTE;
279
280 kVK_ANSI_KeypadDivide : Result := VK_DIVIDE;
281 kVK_ANSI_KeypadEnter : Result := VK_RETURN;
282 kVK_ANSI_KeypadMinus : Result := VK_SUBTRACT;
283
284 kVK_F18 : Result := VK_F18;
285 kVK_F19 : Result := VK_F19;
286
287 //kVK_ANSI_KeypadEquals : Result := VK_;
288 kVK_ANSI_Keypad0 : Result := VK_NUMPAD0;
289 kVK_ANSI_Keypad1 : Result := VK_NUMPAD1;
290 kVK_ANSI_Keypad2 : Result := VK_NUMPAD2;
291 kVK_ANSI_Keypad3 : Result := VK_NUMPAD3;
292 kVK_ANSI_Keypad4 : Result := VK_NUMPAD4;
293 kVK_ANSI_Keypad5 : Result := VK_NUMPAD5;
294 kVK_ANSI_Keypad6 : Result := VK_NUMPAD6;
295 kVK_ANSI_Keypad7 : Result := VK_NUMPAD7;
296
297 kVK_F20 : Result := VK_F20;
298
299 kVK_ANSI_Keypad8 : Result := VK_NUMPAD8;
300 kVK_ANSI_Keypad9 : Result := VK_NUMPAD9;
301
302 //kVK_JIS_Yen = $5D;
303 //kVK_JIS_Underscore = $5E;
304 //kVK_JIS_KeypadComma = $5F;
305
306 kVK_F5 : Result := VK_F5;
307 kVK_F6 : Result := VK_F6;
308 kVK_F7 : Result := VK_F7;
309 kVK_F3 : Result := VK_F3;
310 kVK_F8 : Result := VK_F8;
311 kVK_F9 : Result := VK_F9;
312
313 //kVK_JIS_Eisu = $66;
314 kVK_JIS_Kana : Result := VK_KANA;
315
316 kVK_F11 : Result := VK_F11;
317
318 kVK_F13 : Result := VK_SNAPSHOT;
319 kVK_F16 : Result := VK_F16;
320 kVK_F14 : Result := VK_SCROLL;
321 kVK_F10 : Result := VK_F10;
322
323 kVK_SubMenu : Result := VK_APPS;
324
325 kVK_F12 : Result := VK_F12;
326 kVK_F15 : Result := VK_PAUSE;
327 kVK_Help : Result := VK_HELP; //VK_INSERT; // todo!
328 kVK_Home : Result := VK_HOME;
329 kVK_PageUp : Result := VK_PRIOR;
330 kVK_ForwardDelete : Result := VK_DELETE; // VK_BACK?
331 kVK_F4 : Result := VK_F4;
332 kVK_End : Result := VK_END;
333 kVK_F2 : Result := VK_F2;
334 kVK_PageDown : Result := VK_NEXT;
335 kVK_F1 : Result := VK_F1;
336 kVK_LeftArrow : Result := VK_LEFT;
337 kVK_RightArrow : Result := VK_RIGHT;
338 kVK_DownArrow : Result := VK_DOWN;
339 kVK_UpArrow : Result := VK_UP;
340
341 else
342 Result := VK_UNKNOWN;
343 end;
344 end;
345
346 function MacCharToVK(achar: unichar): Word;
347 var
348 ch : AnsiChar;
349 begin
350 // only handle printable characters here in Ansi range
351 // all other should be taken care of in MacCodeToVk
352 if (achar < 32) or (achar>127) then begin
353 Result := VK_UNKNOWN;
354 Exit;
355 end;
356 ch := AnsiChar(achar and $FF);
357 case ch of
358 'a'..'z': Result := VK_A+ord(ch)-ord('a');
359 'A'..'Z': Result := ord(ch);
360 '`','~': Result := VK_LCL_TILDE;
361 '[','{': Result := VK_LCL_OPEN_BRAKET;
362 ']','}': Result := VK_LCL_CLOSE_BRAKET;
363 '\','|': Result := VK_LCL_BACKSLASH;
364 ';',':': Result := VK_LCL_SEMI_COMMA;
365 '''','"': Result := VK_LCL_QUOTE;
366 ',','<': Result := VK_LCL_COMMA;
367 '>','.': Result := VK_LCL_POINT;
368 // make sure that KeyCodes are not related to numpad
369 '=','+': Result := VK_LCL_EQUAL;
370 '-','_': Result := VK_LCL_MINUS;
371 '/','?': Result := VK_LCL_SLASH;
372 else
373 Result := VK_UNKNOWN;
374 end;
375 end;
376
377 procedure ColorToRGBFloat(cl: TColorRef; var r,g,b: Single); inline;
378 begin
379 R:=(cl and $FF) / $FF;
380 G:=((cl shr 8) and $FF) / $FF;
381 B:=((cl shr 16) and $FF) / $FF;
382 end;
383
384 function RGBToColorFloat(r,g,b: Single): TColorRef; inline;
385 begin
386 Result:=(Round(b*$FF) shl 16) or (Round(g*$FF) shl 8) or Round(r*$FF);
387 end;
388
389 function NSColorToRGB(const Color: NSColor): TColorRef; inline;
390 var
391 alpha: CGFloat;
392 begin
393 // TColorRef doesn't bear an alpha channel information.
394 // Thus RGB needs to be multiplied by it.
395 alpha := Color.alphaComponent;
396 with Color do
397 Result := RGBToColorFloat(redComponent*alpha, greenComponent*alpha, blueComponent*alpha);
398 end;
399
NSColorToColorRefnull400 function NSColorToColorRef(const Color: NSColor): TColorRef;
401
AverageColornull402 function AverageColor(Color1, Color2: TColorRef): TColorRef; inline;
403 begin
404 if Color1 = Color2 then
405 Result := Color1
406 else
407 Result :=
408 (((Color1 and $FF) + (Color2 and $FF)) shr 1) and $FF or
409 (((((Color1 shr 8) and $FF) + ((Color2 shr 8) and $FF)) shr 1) and $FF) shl 8 or
410 (((((Color1 shr 16) and $FF) + ((Color2 shr 16) and $FF)) shr 1) and $FF) shl 16;
411 end;
412
413 var
414 LocalPool: NSAutoReleasePool;
415 RGBColor, PatternColor: NSColor;
416 ImageRep: NSImageRep;
417 x, y: Integer;
418 begin
419 LocalPool := NSAutoReleasePool.alloc.init;
420 RGBColor := Color.colorUsingColorSpaceName(NSDeviceRGBColorSpace);
421 // if color is a pattern it can't be converted as is to a solid color value
422 if RGBColor = nil then
423 begin
424 PatternColor := Color.colorUsingColorSpaceName(NSPatternColorSpace);
425 if PatternColor = nil then
426 Result := 0
427 else
428 begin
429 // compute an average color of the top left 2x2 rectangle
430 ImageRep := PatternColor.patternImage.bestRepresentationForRect_context_hints(NSNullRect, nil, nil);
431 if (ImageRep = nil) or not ImageRep.isKindOfClass(NSBitmapImageRep) then
432 Result := 0
433 else
434 begin
435 Result := 0; // getting rid of compiler warning
436 for y := 0 to ImageRep.pixelsHigh - 1 do
437 for x := 0 to ImageRep.pixelsWide - 1 do
438 begin
439 RGBColor := NSBitmapImageRep(ImageRep).colorAtX_y(x, y).colorUsingColorSpaceName(NSDeviceRGBColorSpace);
440 if Assigned(RGBColor) then
441 begin
442 if (x = 0) and (y = 0) then
443 Result := NSColorToRGB(RGBColor)
444 else
445 Result := AverageColor(Result, NSColorToRGB(RGBColor))
446 end
447 else
448 begin
449 Result := 0;
450 break;
451 end
452 end;
453 end;
454 end;
455 end
456 else
457 Result := NSColorToRGB(RGBColor);
458 LocalPool.release;
459 end;
460
461 function ColorToNSColor(const Color: TColorRef): NSColor; inline;
462 begin
463 Result := NSColor.colorWithDeviceRed_green_blue_alpha(
464 (Color and $FF) / $FF,
465 ((Color shr 8) and $FF) / $FF,
466 ((Color shr 16) and $FF) / $FF, 1);
467 end;
468
469 function SysColorToNSColor(nIndex: Integer): NSColor;
470 const
471 ToolTipBack = $C9FCF9;
472 ToolTipBack1010 = $EDEDED;
473 ToolTipBack1014 = $f0f0f0;
474 ToolTipBack1014Dark = $343434;
475 begin
476 case NIndex of
477 COLOR_GRADIENTACTIVECAPTION, COLOR_ACTIVECAPTION,
478 COLOR_WINDOWFRAME, COLOR_ACTIVEBORDER:
479 Result := NSColor.windowFrameColor;
480 COLOR_GRADIENTINACTIVECAPTION, COLOR_INACTIVECAPTION, COLOR_INACTIVEBORDER:
481 Result := NSColor.windowBackgroundColor;
482 COLOR_CAPTIONTEXT,
483 COLOR_INACTIVECAPTIONTEXT:
484 Result := NSColor.windowFrameTextColor;
485 COLOR_WINDOW:
486 Result := NSColor.textBackgroundColor;
487 COLOR_BACKGROUND,
488 COLOR_FORM:
489 Result := NSColor.windowBackgroundColor;
490 COLOR_MENU:
491 Result := NSColor.controlBackgroundColor;
492 COLOR_MENUTEXT:
493 Result := NSColor.controlTextColor;
494 COLOR_MENUBAR:
495 Result := NSColor.selectedTextBackgroundColor;
496 COLOR_MENUHILIGHT:
497 Result := NSColor.selectedMenuItemColor;
498 COLOR_WINDOWTEXT:
499 Result := NSColor.controlTextColor;
500 COLOR_APPWORKSPACE:
501 Result := NSColor.windowBackgroundColor;
502 COLOR_HIGHLIGHT:
503 Result := NSColor.selectedControlColor;
504 COLOR_HOTLIGHT:
505 Result := NSColor.alternateSelectedControlColor;
506 COLOR_HIGHLIGHTTEXT:
507 Result := NSColor.selectedControlTextColor;
508 COLOR_SCROLLBAR:
509 Result := NSColor.scrollBarColor;
510 COLOR_BTNFACE:
511 Result := NSColor.controlBackgroundColor;
512 COLOR_BTNSHADOW: // COLOR_3DSHADOW
513 if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
514 Result := NSColor.controlColor.shadowWithLevel(0.5)
515 else
516 Result := NSColor.controlShadowColor;
517 COLOR_BTNHIGHLIGHT:
518 if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
519 Result := NSColor.controlColor.shadowWithLevel(0.0)
520 else
521 Result := NSColor.controlLightHighlightColor;//controlHighlightColor has no contrast with COLOR_BTNFACE which affects TBevel. In Win32 this has value white
522 COLOR_BTNTEXT:
523 Result := NSColor.controlTextColor;
524 COLOR_GRAYTEXT:
525 Result := NSColor.disabledControlTextColor;
526 COLOR_3DDKSHADOW:
527 if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
528 Result := NSColor.controlColor.shadowWithLevel(0.75)
529 else
530 Result := NSColor.controlDarkShadowColor;
531 COLOR_3DLIGHT:
532 if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
533 Result := NSColor.controlColor.shadowWithLevel(0.25)
534 else
535 Result := NSColor.controlHighlightColor;// makes a more consistent result (a very light gray) than controlLightHighlightColor (which is white)
536
537 // macOS doesn't provide any API to get the hint window colors.
538 // default = macosx10.4 yellow color. (See InitInternals below)
539 // it's likely the tooltip color will change in future.
540 // Thus the variable is left public, so a user of LCL
541 // would be able to initialize it properly on start
542 COLOR_INFOTEXT:
543 Result := NSColor.controlTextColor;
544 COLOR_INFOBK:
545 begin
546 if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
547 begin
548 if IsPaintDark then
549 Result := ColorToNSColor(ToolTipBack1014Dark)
550 else
551 Result := ColorToNSColor(ToolTipBack1014);
552 end else if NSAppKitVersionNumber >= NSAppKitVersionNumber10_10 then
553 Result := ColorToNSColor(ToolTipBack1010)
554 else
555 Result := ColorToNSColor(ToolTipBack);
556 end;
557 else
558 Result := nil;
559 end;
560 end;
561
562 var
563 _NSAppearanceClass : pobjc_class = nil;
564 _NSAppearanceClassRead: Boolean = false;
565
566 const
567 DarkName = 'NSAppearanceNameDarkAqua'; // used in 10.14
568 DarkNameVibrant = 'NSAppearanceNameVibrantDark'; // used in 10.13
569
570 function NSAppearanceClass: pobjc_class;
571 begin
572 if not _NSAppearanceClassRead then
573 begin
574 _NSAppearanceClass := objc_getClass('NSAppearance');
575 _NSAppearanceClassRead := true;
576 end;
577 Result := _NSAppearanceClass;
578 end;
579
580 function IsAppearDark(Appear: NSAppearance): Boolean; inline;
581 begin
582 Result := Assigned(Appear)
583 and (
584 Appear.name.isEqualToString(NSSTR(DarkName))
585 or
586 Appear.name.isEqualToString(NSSTR(DarkNameVibrant))
587 )
588 end;
589
590 function IsDarkPossible: Boolean; inline;
591 begin
592 Result := NSAppKitVersionNumber > NSAppKitVersionNumber10_12;
593 end;
594
595 function IsAppDark: Boolean;
596 var
597 Appear: NSAppearance;
598 begin
599 if not isDarkPossible then
600 begin
601 Result := false;
602 Exit;
603 end;
604 if (not NSApplication(NSApp).respondsToSelector(ObjCSelector('effectiveAppearance'))) then begin
605 Result := false;
606 Exit;
607 end;
608
609 Result := IsAppearDark(NSApplication(NSApp).effectiveAppearance);
610 end;
611
612 function IsWinDark(win: NSWindow): Boolean;
613 begin
614 if not Assigned(win) or not isDarkPossible then
615 begin
616 Result := false;
617 Exit;
618 end;
619 if (not win.respondsToSelector(ObjCSelector('effectiveAppearance'))) then begin
620 Result := false;
621 Exit;
622 end;
623
624 Result := IsAppearDark(win.effectiveAppearance);
625 end;
626
627 function IsPaintDark: Boolean;
628 var
629 cls : pobjc_class;
630 begin
631 cls := NSAppearanceClass;
632 if not Assigned(cls) then Exit;
633 Result := IsAppearDark(objc_msgSend(cls, ObjCSelector('currentAppearance')));
634 end;
635
636 function CFStringToString(AString: CFStringRef): String;
637 begin
638 result:=CFStringToStr(AString);
639 end;
640
641 function GetNSObjectWindow(obj: NSObject): NSWindow;
642 begin
643 Result := nil;
644 if not Assigned(obj) then Exit;
645 if obj.isKindOfClass_(NSWindow) then
646 Result := NSWindow(obj)
647 else if obj.isKindOfClass_(NSView) then
648 Result := NSView(obj).window;
649 end;
650
651 function GetNSSize(width, height: CGFloat): NSSize; inline;
652 begin
653 Result.height := height;
654 Result.width := width;
655 end;
656
657 function GetNSPoint(x, y: single): NSPoint;
658 begin
659 Result.x := x;
660 Result.y := y;
661 end;
662
663 function LCLToNSPoint(APt: TPoint; ParentHeight: Single): NSPoint;
664 begin
665 Result.X := APt.X;
666 Result.Y := ParentHeight - APt.Y;
667 end;
668
669 function GetNSRect(x, y, width, height: Integer): NSRect;
670 begin
671 with Result do
672 begin
673 origin.x := x;
674 origin.y := y;
675 size.width := width;
676 size.height := height;
677 end;
678 end;
679
680 function GetCGRect(x1, y1, x2, y2: Integer): CGRect;
681 begin
682 with Result do
683 begin
684 origin.x := x1;
685 origin.y := y1;
686 size.width := x2 - x1;
687 size.height := y2 - y1;
688 end;
689 end;
690
691 function GetCGRectSorted(X1, Y1, X2, Y2: Integer): CGRect;
692 begin
693 if X1 <= X2 then
694 begin
695 Result.origin.x := X1;
696 Result.size.width := X2 - X1;
697 end
698 else
699 begin
700 Result.origin.x := X2;
701 Result.size.width := X1 - X2;
702 end;
703
704 if Y1 <= Y2 then
705 begin
706 Result.origin.y := Y1;
707 Result.size.height := Y2 - Y1;
708 end
709 else
710 begin
711 Result.origin.y := Y2;
712 Result.size.height := Y1 - Y2;
713 end;
714 end;
715
716 function RectToCGRect(const R: TRect): CGRect;
717 begin
718 with R do
719 Result := GetCGRect(Left, Top, Right, Bottom);
720 end;
721
722 function CGRectToRect(const c: CGRect): TRect;
723 begin
724 if CGRectIsEmpty(c) <> 0 then
725 Result := Rect(0,0,0,0)
726 else if CGRectIsInfinite(c) <> 0 then
727 Result:= Rect(Low(Integer), Low(Integer), High(Integer), High(Integer))
728 else begin
729 Result.Left := Round(c.origin.x);
730 Result.Top := Round(c.origin.y);
731 Result.Right := Round(c.origin.x + c.size.width);
732 Result.Bottom := Round(c.origin.y + c.size.height);
733 end;
734 end;
735
736 function RectToNSRect(const r: TRect): NSRect;
737 begin
738 with R do
739 Result := GetNSRect(Left, Top, Right - Left, Bottom - Top);
740 end;
741
742 function NSRectToRect(const NS: NSRect): TRect;
743 begin
744 Result.Left := Round(ns.origin.x);
745 Result.Top := Round(ns.origin.y);
746 Result.Right := Round(ns.origin.x + ns.size.width);
747 Result.Bottom := Round(ns.origin.y + ns.size.height);
748 end;
749
750 procedure NSToLCLRect(const ns: NSRect; ParentHeight: Single; out lcl: TRect);
751 begin
752 lcl.Left := Round(ns.origin.x);
753 lcl.Top := Round(ParentHeight - ns.size.height - ns.origin.y);
754 lcl.Right := Round(ns.origin.x + ns.size.width);
755 lcl.Bottom := Round(lcl.Top + ns.size.height);
756 end;
757
758 procedure LCLToNSRect(const lcl: TRect; ParentHeight: Single; out ns: NSRect);
759 begin
760 ns.origin.x:=lcl.left;
761 ns.origin.y:=ParentHeight-lcl.bottom;
762 ns.size.width:=lcl.Right-lcl.Left;
763 ns.size.height:=lcl.Bottom-lcl.Top;
764 end;
765
766 function NSScreenZeroHeight: CGFloat;
767 begin
768 Result := NSScreen(NSScreen.screens.objectAtIndex(0)).frame.size.height;
769 end;
770
771 function CreateParamsToNSRect(const params: TCreateParams): NSRect;
772 begin
773 with params do Result:=GetNSRect(X,Y,Width,Height);
774 end;
775
776 function NSStringUtf8(s: PChar): NSString;
777 var
778 cf: CFStringRef;
779 r: Integer;
780 begin
781 {NSString and CFStringRef are interchangable}
782 cf := CFStringCreateWithCString(nil, S, kCFStringEncodingUTF8);
783 Result := NSString(cf);
784 end;
785
786 function NSStringUtf8(const s: String): NSString;
787 var
788 cf: CFStringRef;
789 begin
790 {NSString and CFStringRef are interchangable}
791 cf := CFStringCreateWithCString(nil, Pointer(PChar(S)), kCFStringEncodingUTF8);
792 Result := NSString(cf);
793 end;
794
795 function NSStringToString(ns: NSString): String;
796 begin
797 Result := CFStringToStr(CFStringRef(ns));
798 end;
799
800 procedure SetNSText(text: NSText; const s: String); inline;
801 var
802 ns: NSString;
803 begin
804 if Assigned(text) then
805 begin
806 ns := NSStringUTF8(s);
807 text.setString(ns);
808 ns.release;
809 if Assigned(text.undoManager) then
810 text.undoManager.removeAllActions;
811 end;
812 end;
813
814 function GetNSText(text: NSText): string; inline;
815 begin
816 if Assigned(text) then
817 Result := NSStringToString(text.string_)
818 else
819 Result := '';
820 end;
821
822 procedure SetNSControlValue(c: NSControl; const S: String); inline;
823 var
824 ns: NSString;
825 begin
826 if Assigned(c) then
827 begin
828 ns := NSStringUtf8(S);
829 c.setStringValue(ns);
830 ns.release;
831 end;
832 end;
833
834 function GetNSControlValue(c: NSControl): String; inline;
835 begin
836 if Assigned(c) then
837 Result := NSStringToString(c.stringValue)
838 else
839 Result := '';
840 end;
841
842 { TCocoaInputClient }
843
844 procedure TCocoaInputClient.insertText_replacementRange(aString: id;
845 replacementRange: NSRange);
846 begin
847
848 end;
849
850 procedure TCocoaInputClient.setMarkedText_selectedRange_replacementRange(
851 aString: id; selectedRange: NSRange; replacementRange: NSRange);
852 begin
853
854 end;
855
856 procedure TCocoaInputClient.unmarkText;
857 begin
858
859 end;
860
selectedRangenull861 function TCocoaInputClient.selectedRange: NSRange;
862 begin
863 Result.location := 0;
864 Result.length := 0;
865 end;
866
markedRangenull867 function TCocoaInputClient.markedRange: NSRange;
868 begin
869 Result.location := 0;
870 Result.length := 0;
871 end;
872
hasMarkedTextnull873 function TCocoaInputClient.hasMarkedText: LCLObjCBoolean;
874 begin
875 Result := false;
876 end;
877
attributedSubstringForProposedRange_actualRangenull878 function TCocoaInputClient.attributedSubstringForProposedRange_actualRange(
879 aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
880 begin
881 Result := nil;
882 end;
883
validAttributesForMarkedTextnull884 function TCocoaInputClient.validAttributesForMarkedText: NSArray;
885 begin
886 Result := nil;
887 end;
888
firstRectForCharacterRange_actualRangenull889 function TCocoaInputClient.firstRectForCharacterRange_actualRange(
890 aRange: NSRange; actualRange: NSRangePointer): NSRect;
891 begin
892 Result := NSZeroRect;
893 end;
894
characterIndexForPointnull895 function TCocoaInputClient.characterIndexForPoint(aPoint: NSPoint): NSUInteger;
896 begin
897 Result := 0;
898 end;
899
900 procedure TCocoaInputClient.doCommandBySelector(asel: sel);
901 begin
902
903 end;
904
905
906 { NSLCLDebugExtension }
907
908 function NSLCLDebugExtension.lclClassName: shortstring;
909 begin
910 Result := NSStringToString(self.className);
911 end;
912
913 function VirtualKeyCodeToMacString(AKey: Word): NSString;
914 type
915 WideChar = System.WideChar;
916 var
917 w : WideChar;
918 begin
919 w:=#0;
920 case AKey of
921 VK_MULTIPLY : w := '*';
922 VK_ADD, VK_OEM_PLUS : w := '+';
923 VK_SUBTRACT, VK_OEM_MINUS : w := '-';
924 VK_OEM_COMMA : w := ',';
925 VK_OEM_PERIOD: w := '.';
926 VK_OEM_1 : w := ';';
927 VK_OEM_2 : w := '/';
928 VK_OEM_3 : w := '`';
929 VK_OEM_4 : w := '[';
930 VK_OEM_5 : w := '\';
931 VK_OEM_6 : w := ']';
932 VK_OEM_7 : w := '''';
933 VK_BACK : w := WideChar(NSBackspaceCharacter);
934 VK_CLEAR : w := WideChar(NSClearDisplayFunctionKey);
935 VK_PAUSE : w := WideChar(NSPauseFunctionKey);
936 VK_PRIOR : w := WideChar(NSPageUpFunctionKey);
937 VK_NEXT : w := WideChar(NSPageDownFunctionKey);
938 VK_END : w := WideChar(NSEndFunctionKey);
939 VK_HOME : w := WideChar(NSHomeFunctionKey);
940 VK_LEFT : w := WideChar(NSLeftArrowFunctionKey);
941 VK_UP : w := WideChar(NSUpArrowFunctionKey);
942 VK_RIGHT : w := WideChar(NSRightArrowFunctionKey);
943 VK_DOWN : w := WideChar(NSDownArrowFunctionKey);
944 VK_SELECT : w := WideChar(NSSelectFunctionKey);
945 VK_PRINT : w := WideChar(NSPrintFunctionKey);
946 VK_EXECUTE : w := WideChar(NSExecuteFunctionKey);
947 VK_INSERT : w := WideChar(NSInsertFunctionKey);
948 VK_DELETE : w := WideChar(NSDeleteCharacter);
949 VK_HELP : w := WideChar(NSHelpFunctionKey);
950 VK_SCROLL : w := WideChar(NSScrollLockFunctionKey);
951 VK_F1..VK_F24: w := WideChar(NSF1FunctionKey + AKey - VK_F1);
952 VK_A..VK_Z : w := WideChar(Ord('a') + AKey - VK_A);
953 else
954 w := WideChar(AKey and $ff);
955 end;
956 if w<>#0
957 then Result:=NSString.stringWithCharacters_length(@w, 1)
958 else Result:=NSString.string_;
959 end;
960 {------------------------------------------------------------------------------
961 Name: FillStandardDescription
962 Params: Desc - Raw image description
963
964 Fills the raw image description with standard Cocoa internal image storing
965 description
966 ------------------------------------------------------------------------------}
967 procedure FillStandardDescription(out Desc: TRawImageDescription);
968 begin
969 Desc.Init;
970
971 Desc.Format := ricfRGBA;
972 // Width and Height skipped
973 Desc.PaletteColorCount := 0;
974
975 Desc.BitOrder := riboReversedBits;
976 Desc.ByteOrder := riboMSBFirst;
977 Desc.LineEnd := rileDQWordBoundary; // 128bit aligned
978
979 Desc.LineOrder := riloTopToBottom;
980 Desc.BitsPerPixel := 32;
981 Desc.Depth := 32;
982
983 // 8-8-8-8 mode, $AARRGGBB
984 Desc.RedPrec := 8;
985 Desc.GreenPrec := 8;
986 Desc.BluePrec := 8;
987 Desc.AlphaPrec := 8;
988
989 Desc.AlphaShift := 24;
990 Desc.RedShift := 16;
991 Desc.GreenShift := 08;
992 Desc.BlueShift := 00;
993
994 Desc.MaskBitOrder := riboReversedBits;
995 Desc.MaskBitsPerPixel := 1;
996 Desc.MaskLineEnd := rileByteBoundary;
997 Desc.MaskShift := 0;
998 end;
999
1000 {------------------------------------------------------------------------------
1001 Name: CreateCFString
1002 Params: S - UTF-8 string
1003 AString - Core Foundation string ref
1004
1005 Creates new Core Foundation string from the specified string
1006 ------------------------------------------------------------------------------}
1007 procedure CreateCFString(const S: String; out AString: CFStringRef);
1008 begin
1009 AString := CFStringCreateWithCString(nil, Pointer(PChar(S)), DEFAULT_CFSTRING_ENCODING);
1010 end;
1011
1012 {------------------------------------------------------------------------------
1013 Name: CreateCFString
1014 Params: Data - CFDataRef
1015 Encoding - Data encoding format
1016 AString - Core Foundation string ref
1017
1018 Creates new Core Foundation string from the specified data and format
1019 ------------------------------------------------------------------------------}
1020 procedure CreateCFString(const Data: CFDataRef; Encoding: CFStringEncoding; out
1021 AString: CFStringRef);
1022 begin
1023 AString := nil;
1024 if Data = nil then Exit;
1025 AString := CFStringCreateWithBytes(nil, CFDataGetBytePtr(Data),
1026 CFDataGetLength(Data), Encoding, False);
1027 end;
1028
1029 {------------------------------------------------------------------------------
1030 Name: FreeCFString
1031 Params: AString - Core Foundation string ref to free
1032
1033 Frees specified Core Foundation string
1034 ------------------------------------------------------------------------------}
1035 procedure FreeCFString(var AString: CFStringRef);
1036 begin
1037 if AString <> nil then
1038 CFRelease(Pointer(AString));
1039 end;
1040
1041 {------------------------------------------------------------------------------
1042 Name: CFStringToStr
1043 Params: AString - Core Foundation string ref
1044 Encoding - Result data encoding format
1045 Returns: UTF-8 string
1046
1047 Converts Core Foundation string to string
1048 ------------------------------------------------------------------------------}
1049 function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding): String;
1050 var
1051 Str: Pointer;
1052 StrSize: CFIndex;
1053 StrRange: CFRange;
1054 begin
1055 if AString = nil then
1056 begin
1057 Result := '';
1058 Exit;
1059 end;
1060
1061 // Try the quick way first
1062 Str := CFStringGetCStringPtr(AString, Encoding);
1063 if Str <> nil then
1064 Result := PChar(Str)
1065 else
1066 begin
1067 // if that doesn't work this will
1068 StrRange.location := 0;
1069 StrRange.length := CFStringGetLength(AString);
1070
1071 CFStringGetBytes(AString, StrRange, Encoding,
1072 Ord('?'), False, nil, 0, StrSize);
1073 SetLength(Result, StrSize);
1074
1075 if StrSize > 0 then
1076 CFStringGetBytes(AString, StrRange, Encoding,
1077 Ord('?'), False, @Result[1], StrSize, StrSize);
1078 end;
1079 end;
1080
1081 {------------------------------------------------------------------------------
1082 Name: CFStringToData
1083 Params: AString - Core Foundation string ref
1084 Encoding - Result data encoding format
1085 Returns: CFDataRef
1086
1087 Converts Core Foundation string to data
1088 ------------------------------------------------------------------------------}
CFStringToDatanull1089 function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding): CFDataRef;
1090 var
1091 S: String;
1092 begin
1093 Result := nil;
1094 if AString = nil then Exit;
1095 S := CFStringToStr(AString, Encoding);
1096
1097 if Length(S) > 0 then
1098 Result := CFDataCreate(nil, @S[1], Length(S))
1099 else
1100 Result := CFDataCreate(nil, nil, 0);
1101 end;
1102
GetCurrentEventTimenull1103 function GetCurrentEventTime: double;
1104 // returns seconds since system startup
1105 begin
1106 Result := AbsoluteToDuration(UpTime) / 1000.0;
1107 end;
1108
GetMacOSXVersionnull1109 function GetMacOSXVersion: Integer;
1110 var
1111 lVersionNSStr: NSString;
1112 lVersionStr: string;
1113 lParser: TStringList;
1114 lMajor: integer = 0;
1115 lMinor: integer = 0;
1116 lFix: integer = 0;
1117 begin
1118 Result := 0;
1119 lVersionNSStr := NSProcessInfo.processInfo.operatingSystemVersionString;
1120 lVersionStr := NSStringToString(lVersionNSStr);
1121 lParser := TStringList.Create;
1122 try
1123 lParser.Delimiter := ' ';
1124 lParser.DelimitedText := lVersionStr;
1125 if lParser.Count >= 2 then
1126 begin
1127 lVersionStr := lParser.Strings[1];
1128 lParser.Delimiter := '.';
1129 lParser.DelimitedText := lVersionStr;
1130 if lParser.Count = 3 then
1131 begin
1132 TryStrToInt(lParser.Strings[0], lMajor);
1133 TryStrToInt(lParser.Strings[1], lMinor);
1134 TryStrToInt(lParser.Strings[2], lFix);
1135 end;
1136 end;
1137 finally
1138 lParser.Free;
1139 end;
1140 Result := lMajor*$10000 + lMinor*$100 + lFix;
1141 end;
1142
DateTimeToNSDatenull1143 function DateTimeToNSDate(const aDateTime : TDateTime): NSDate;
1144 {var
1145 ti : NSTimeInterval;
1146 begin
1147 ti := (aDateTime - EncodeDate(2001, 1, 1)) * SecsPerDay;
1148 ti := ti - double(NSTimeZone.localTimeZone.secondsFromGMT);
1149 Result := NSDate.dateWithTimeIntervalSinceReferenceDate(ti);}
1150 var
1151 cmp : NSDateComponents;
1152 y,m,d: Word;
1153 h,s,z: Word;
1154 begin
1155 cmp := NSDateComponents.alloc.init;
1156 DecodeDate(ADateTime, y,m,d);
1157 cmp.setYear(y);
1158 cmp.setMonth(m);
1159 cmp.setDay(d);
1160 DecodeTime(ADateTime, h, m, s,z);
1161 cmp.setHour(h);
1162 cmp.setMinute(m);
1163 cmp.setSecond(s);
1164 Result := NSCalendar.currentCalendar.dateFromComponents(cmp);
1165 end;
1166
NSDateToDateTimenull1167 function NSDateToDateTime(const aDateTime: NSDate): TDateTime;
1168 var
1169 cmp : NSDateComponents;
1170 mn : TdateTime;
1171 const
1172 convFlag = NSYearCalendarUnit
1173 or NSMonthCalendarUnit
1174 or NSDayCalendarUnit
1175 or NSHourCalendarUnit
1176 or NSMinuteCalendarUnit
1177 or NSSecondCalendarUnit;
1178 begin
1179 if aDateTime = nil then
1180 begin
1181 Result:= 0.0;
1182 Exit;
1183 end;
1184 cmp := NSCalendar.currentCalendar.components_fromDate(convFlag, aDateTime);
1185 TryEncodeDate(cmp.year, cmp.month, cmp.day, Result);
1186 TryEncodeTime(cmp.hour, cmp.minute, cmp.second, 0, mn);
1187 Result := Result + mn;
1188 end;
1189
ControlTitleToStrnull1190 function ControlTitleToStr(const ATitle: string): String;
1191 begin
1192 Result := ATitle;
1193 DeleteAmpersands(Result);
1194 end;
1195
ControlTitleToNSStrnull1196 function ControlTitleToNSStr(const ATitle: string): NSString;
1197 var
1198 t: string;
1199 begin
1200 t := ControlTitleToStr(ATitle);
1201 if t = '' then Result:=NSString.string_ // empty string
1202 else Result := NSString.stringWithUTF8String( @t[1] );
1203 end;
1204
1205 procedure AddLayoutToFrame(const layout: TRect; var frame: TRect);
1206 begin
1207 inc(frame.Left, layout.Left);
1208 inc(frame.Top, layout.Top);
1209 inc(frame.Right, layout.Right);
1210 inc(frame.Bottom, layout.Bottom);
1211 end;
1212
1213 procedure SubLayoutFromFrame(const layout: TRect; var frame: TRect);
1214 begin
1215 dec(frame.Left, layout.Left);
1216 dec(frame.Top, layout.Top);
1217 dec(frame.Right, layout.Right);
1218 dec(frame.Bottom, layout.Bottom);
1219 end;
1220
NSEventRawKeyCharnull1221 function NSEventRawKeyChar(ev: NSEvent): System.WideChar;
1222 var
1223 m : NSString;
1224 begin
1225 m := ev.charactersIgnoringModifiers;
1226 if m.length <> 1 then
1227 Result := #0
1228 else
1229 Result := System.WideChar(m.characterAtIndex(0));
1230 end;
1231
AllocImageRotatedByDegreesnull1232 function AllocImageRotatedByDegrees(src: NSImage; degrees: double): NSImage;
1233 var
1234 imageBounds : NSRect;
1235 pathBounds : NSBezierPath;
1236 transform : NSAffineTransform;
1237 rotatedBounds : NSRect;
1238 rotatedImage : NSImage;
1239 begin
1240 if not Assigned(src) then
1241 begin
1242 Result := nil;
1243 Exit;
1244 end;
1245
1246 // src: https://stackoverflow.com/questions/31699235/rotate-nsimage-in-swift-cocoa-mac-osx
1247
1248 imageBounds.size := src.size;
1249 pathBounds := NSBezierPath.bezierPathWithRect(imageBounds);
1250 transform := NSAffineTransform.alloc.init;
1251 transform.rotatebyDegrees(degrees);
1252 pathBounds.transformUsingAffineTransform(transform);
1253 rotatedBounds := NSMakeRect(NSZeroPoint.x, NSZeroPoint.y, src.size.width, src.size.height );
1254 rotatedImage := NSImage(NSImage.alloc).initWithSize(rotatedBounds.size);
1255
1256 //Center the image within the rotated bounds
1257 imageBounds.origin.x := NSMidX(rotatedBounds) - (NSWidth(imageBounds) / 2);
1258 imageBounds.origin.y := NSMidY(rotatedBounds) - (NSHeight(imageBounds) / 2);
1259 transform.release;
1260
1261 // Start a new transform
1262 transform := NSAffineTransform.alloc.init;
1263 // Move coordinate system to the center (since we want to rotate around the center)
1264 transform.translateXBy_yBy(rotatedBounds.size.width / 2, rotatedBounds.size.width / 2);
1265 transform.rotateByDegrees(degrees);
1266 // Move the coordinate system bak to normal
1267 transform.translateXBy_yBy(-rotatedBounds.size.width / 2, -rotatedBounds.size.height / 2);
1268 // Draw the original image, rotated, into the new image
1269 rotatedImage.lockFocus;
1270 transform.concat();
1271 src.drawInRect_fromRect_operation_fraction(imageBounds, NSZeroRect, NSCompositeCopy, 1.0);
1272 rotatedImage.unlockFocus();
1273 Result := rotatedImage;
1274
1275 transform.release;
1276 end;
1277
AllocCursorFromCursorByDegreesnull1278 function AllocCursorFromCursorByDegrees(src: NSCursor; degrees: double): NSCursor;
1279 var
1280 img : NSImage;
1281 begin
1282 img := AllocImageRotatedByDegrees(src.image, degrees);
1283 //todo: a better hotspot detection
1284 Result := NSCursor.alloc.initWithImage_hotSpot(
1285 img,
1286 NSMakePoint(img.size.height / 2, img.size.width / 2)
1287 );
1288 img.release;
1289 end;
1290
1291 end.
1292
1293