1{%MainUnit carbonprivate.pp}
2{
3 *****************************************************************************
4  This file is part of the Lazarus Component Library (LCL)
5
6  See the file COPYING.modifiedLGPL.txt, included in this distribution,
7  for details about the license.
8 *****************************************************************************
9}
10
11// ==================================================================
12// H A N D L E R S
13// ==================================================================
14
15
16procedure SendMenuActivate(AMenu: MenuRef; MenuIdx: MenuItemIndex);
17var
18  CarbonMenu  : TCarbonMenu;
19  Msg         : TLMessage;
20  S : ByteCount;
21begin
22  if GetMenuItemProperty(AMenu, MenuIdx, LAZARUS_FOURCC,
23       WIDGETINFO_FOURCC, SizeOf(TCarbonMenu), S{%H-}, @CarbonMenu) = noErr then
24  begin
25    FillChar(Msg{%H-}, SizeOf(Msg), 0);
26    Msg.msg := LM_ACTIVATE;
27    CarbonMenu.LCLMenuItem.Dispatch(Msg);
28  end;
29end;
30
31
32
33{------------------------------------------------------------------------------
34  Name: CarbonWindow_Close
35 ------------------------------------------------------------------------------}
36function CarbonWindow_Close(ANextHandler: EventHandlerCallRef;
37  AEvent: EventRef;
38  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
39var
40  Msg: TLMessage;
41begin
42  {$IFDEF VerboseWindowEvent}
43    DebugLn('CarbonWindow_Close: ', DbgSName(AWidget.LCLObject));
44  {$ENDIF}
45  // Do canclose query, if false then exit
46
47  FillChar(Msg{%H-}, SizeOf(Msg),0);
48  Msg.msg := LM_CLOSEQUERY;
49
50  // Message results : 0 - do nothing, 1 - destroy window
51  if DeliverMessage(AWidget.LCLObject, Msg) = 0 then
52  begin
53    Result := noErr;
54    Exit;
55  end;
56
57  {$IFDEF VerboseWindowEvent}
58    DebugLn('CarbonWindow_Close Free: ', DbgSName(AWidget.LCLObject));
59  {$ENDIF}
60
61  Result := CallNextEventHandler(ANextHandler, AEvent);
62end;
63
64{------------------------------------------------------------------------------
65  Name: CarbonWindow_MouseProc
66  Handles mouse events
67 ------------------------------------------------------------------------------}
68function CarbonWindow_MouseProc(ANextHandler: EventHandlerCallRef;
69  AEvent: EventRef;
70  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
71var
72  Control: ControlRef;    // the control we are dealing with
73                          // or the rootcontrol if none found
74  Widget: TCarbonWidget;  // the widget specific to the mouse event
75                          // or the window's widgetinfo if none found
76  Postpone: Boolean;
77const
78  SName = 'CarbonWindow_MouseProc';
79
80//
81// helper functions used commonly
82//
83  function GetMousePoint: TPoint;
84  begin
85    Result:=Widget.LCLObject.ScreenToClient(Mouse.CursorPos);
86  end;
87
88  function GetMouseWheelAxisHorz: boolean;
89  var
90    Val: EventMouseWheelAxis;
91  begin
92    Result := False;
93    if OSError(
94      GetEventParameter(AEvent, kEventParamMouseWheelAxis, typeMouseWheelAxis, nil,
95        SizeOf(Val), nil, @Val),
96      SName, SGetEvent, 'kEventParamMouseWheelAxis') then Exit;
97
98    Result := Val=kEventMouseWheelAxisX;
99  end;
100
101  function GetMouseWheelDelta: Integer;
102  var
103    WheelDelta: SInt32;
104    CCtl: TCarbonCustomControl;
105    ScrollInfo: TScrollInfo;
106  begin
107    Result := 0;
108
109    if OSError(
110      GetEventParameter(AEvent, kEventParamMouseWheelDelta, typeSInt32, nil,
111        SizeOf(WheelDelta), nil, @WheelDelta),
112      SName, SGetEvent, 'kEventParamMouseWheelDelta') then Exit;
113
114    // Carbon's WheelDelta is the number of lines to be scrolled
115    // LCL expects the delta to be 120 for each wheel step, which should scroll
116    // Mouse.WheelScrollLines lines (defaults to three)
117    // Update: 20111212 by zeljko: All widgetsets sends WheelDelta +-120
118    // mac sends 1 or -1 so we just recalc that to wheel delta. see issue #20888
119    Result := (120 * WheelDelta) div Mouse.WheelScrollLines;
120    if Widget.ClassType = TCarbonCustomControl then
121    begin
122      CCtl := TCarbonCustomControl(Widget);
123      if CCtl.GetScrollbarVisible(SB_VERT) then
124      begin
125        FillChar(ScrollInfo{%H-}, SizeOf(ScrollInfo), #0);
126        ScrollInfo.fMask := SIF_TRACKPOS;
127        ScrollInfo.cbSize := SizeOf(ScrollInfo);
128        CCtl.GetScrollInfo(SB_VERT, ScrollInfo);
129        if (WheelDelta > 0) and (ScrollInfo.nTrackPos = 0) then
130          Result := 120;
131      end;
132    end;
133    {$IFDEF VerboseMouse}
134      DebugLn('GetMouseWheelDelta WheelDelta=', DbgS(WheelDelta), ' ', HexStr(WheelDelta, 8));
135    {$ENDIF}
136  end;
137
138//
139// handler functions
140//
141  procedure HandleMouseDownEvent(var AMsg);
142  var
143    MouseButton: Integer;
144    MousePoint: TPoint;
145    Msg: ^TLMMouse;
146  begin
147    {$IFDEF VerboseMouse}
148      DebugLn('HandleMouseDownEvent');
149    {$ENDIF}
150    Msg := @AMsg;
151
152    MouseButton := GetCarbonMouseButton(AEvent);
153    MousePoint := GetMousePoint;
154
155    Msg^.Msg := CheckMouseButtonDownUp(TLCLIntfHandle(Widget), Widget.LCLObject, LastMouse,
156      Widget.LCLObject.ClientToScreen(MousePoint), MouseButton, True);
157    //debugln('HandleMouseDownEvent CliCount=',dbgs(ClickCount),' MouseButton=',dbgs(MouseButton),' Pos=',dbgs(MousePoint));
158
159
160    Msg^.XPos := MousePoint.X;
161    Msg^.YPos := MousePoint.Y;
162    Msg^.Keys := GetCarbonMsgKeyState;
163    case LastMouse.ClickCount of
164      2: Msg^.Keys := Msg^.Keys or MK_DOUBLECLICK;
165      3: Msg^.Keys := Msg^.Keys or MK_TRIPLECLICK;
166      4: Msg^.Keys := Msg^.Keys or MK_QUADCLICK;
167    end;
168    CarbonWidgetSet.SetCaptureWidget(HWND(Widget));
169
170    if LastMouse.ClickCount > 1 then Postpone := True;
171  end;
172
173  procedure HandleMouseUpEvent(var AMsg);
174  var
175    MouseButton: Integer;
176    MousePoint: TPoint;
177    Msg: ^TLMMouse;
178  begin
179    {$IFDEF VerboseMouse}
180      DebugLn('HandleMouseUpEvent');
181    {$ENDIF}
182    // this is not called if NextHandler is called on MouseDown
183    // perhaps mousetracking can fix this
184    Msg := @AMsg;
185
186    MouseButton := GetCarbonMouseButton(AEvent);
187    MousePoint := GetMousePoint;
188
189    Msg^.Msg := CheckMouseButtonDownUp(TLCLIntfHandle(Widget), Widget.LCLObject, LastMouse,
190      Widget.LCLObject.ClientToScreen(MousePoint), MouseButton, False);
191
192    Msg^.XPos := MousePoint.X;
193    Msg^.YPos := MousePoint.Y;
194    Msg^.Keys := GetCarbonMsgKeyState;
195    case LastMouse.ClickCount of
196      2: Msg^.Keys := Msg^.Keys or MK_DOUBLECLICK;
197      3: Msg^.Keys := Msg^.Keys or MK_TRIPLECLICK;
198      4: Msg^.Keys := Msg^.Keys or MK_QUADCLICK;
199    end;
200
201    CarbonWidgetSet.SetCaptureWidget(0);
202  end;
203
204  procedure HandleMouseMovedEvent(var AMsg);
205  var
206    MousePoint: TPoint;
207    MSg: ^TLMMouseMove;
208  begin
209    {$IFDEF VerboseMouse}
210      DebugLn('HandleMouseMovedEvent');
211    {$ENDIF}
212    Msg := @AMsg;
213
214    MousePoint := GetMousePoint;
215
216    Msg^.Msg := LM_MOUSEMOVE;
217    Msg^.XPos := SmallInt(MousePoint.X);
218    Msg^.YPos := SmallInt(MousePoint.Y);
219    Msg^.Keys := GetCarbonMsgKeyState;
220  end;
221
222  procedure HandleMouseDraggedEvent(var {%H-}AMsg);
223  begin
224    {$IFDEF VerboseMouse}
225      DebugLn('-- mouse dragged --');
226    {$ENDIF}
227    // TODO
228  end;
229
230  procedure HandleMouseWheelEvent(var AMsg);
231  var
232    MousePoint: TPoint;
233    Msg: ^TLMMouseEvent;
234  begin
235    {$IFDEF VerboseMouse}
236      DebugLn('HandleMouseWheelEvent');
237    {$ENDIF}
238    Msg := @AMsg;
239
240    MousePoint := GetMousePoint;
241
242    if GetMouseWheelAxisHorz then
243      Msg^.Msg := LM_MOUSEHWHEEL
244    else
245      Msg^.Msg := LM_MOUSEWHEEL;
246    Msg^.Button := GetCarbonMouseButton(AEvent);
247    Msg^.X := MousePoint.X;
248    Msg^.Y := MousePoint.Y;
249    Msg^.State := GetCarbonShiftState;
250    Msg^.WheelDelta := GetMouseWheelDelta;
251  end;
252
253var
254  Msg: record
255    Message: TLMessage;
256    Extra: array[0..20] of Byte; // some messages are a bit larger, make some room
257  end;
258  EventKind: UInt32;
259  Part: WindowPartCode;
260  DesignControl: TControl;
261  DesignWidget: TCarbonWidget;
262  DesignView: HIViewRef;
263  P, ClientPt, ControlPt: TPoint;
264  DesignPt: HIPoint;
265  ViewPart: HIViewPartCode;
266  lTmpWidget: TCarbonWidget;
267  LCLObj: TWinControl;
268begin
269  Result := EventNotHandledErr;
270  Postpone := False;
271
272  // check window part code
273  Part := inContent;
274  if not OSError(
275    GetEventParameter(AEvent, kEventParamWindowPartCode, typeWindowPartCode, nil,
276      SizeOf(WindowPartCode), nil, @Part),
277    SName, SGetEvent, 'kEventParamWindowPartCode', eventParameterNotFoundErr) then
278  begin
279    if (Part <> inContent) and (Part <> inDesk) then Exit;
280  end;
281
282  //Find out which control the mouse event should occur for
283  Control := nil;
284  if OSError(HIViewGetViewForMouseEvent(AWidget.Content, AEvent, Control),
285    SName, SViewForMouse) then Exit;
286  if Control = nil then Exit;
287
288  Widget := GetCarbonWidget(Control);
289  while Assigned(Widget) and not Widget.IsEnabled do
290  begin
291    // Here we need to avoid an endless loop which might occur in case
292    // GetParent returns the same widget that we passed
293    lTmpWidget := TCarbonWidget(CarbonWidgetset.GetParent(HWND(Widget)));
294    if lTmpWidget = Widget then Break;
295    Widget := lTmpWidget;
296  end;
297  if Widget = nil then Exit;
298
299  LCLObj := Widget.LCLObject;
300  CheckTransparentWindow(TLCLIntfHandle(Widget), LCLObj);
301  if (Widget=nil) or (LCLObj=nil) then
302    Exit;
303
304  FillChar(Msg{%H-}, SizeOf(Msg), 0);
305
306  EventKind := GetEventKind(AEvent);
307  case EventKind of
308    kEventMouseDown       : HandleMouseDownEvent(Msg);
309    kEventMouseUp         : HandleMouseUpEvent(Msg);
310    kEventMouseMoved,//      : HandleMouseMovedEvent(Msg);
311    kEventMouseDragged    : HandleMouseMovedEvent(Msg);//HandleMouseDraggedEvent(Msg);
312
313    // For the enter and exit events tracking must be enabled
314    // tracking is enabled by defining a rect that you want to track
315    // TODO: Tracking
316    kEventMouseEntered    : Msg.Message.Msg := LM_MOUSEENTER;
317    kEventMouseExited     : Msg.Message.Msg := LM_MOUSELEAVE;
318
319    kEventMouseWheelMoved : HandleMouseWheelEvent(Msg);
320  else
321    Exit(EventNotHandledErr);
322  end;
323
324  if Postpone then
325  begin
326    PostponedDown := True;
327    PostponedDownMsg := TLMMouse(Msg.Message);
328    Result := CallNextEventHandler(ANextHandler, AEvent);
329  end
330  else
331  begin
332    if Widget.NeedDeliverMouseEvent(Msg.Message.Msg, Msg) then begin
333      // Msg is set in the Appropriate HandleMousexxx procedure
334      NotifyApplicationUserInput(Widget.LCLObject, Msg.Message.Msg);
335      if DeliverMessage(Widget.LCLObject, Msg) = 0 then
336      begin
337        Result := EventNotHandledErr;
338      end
339      else  // the LCL does not want the event propagated
340        Result := noErr;
341    end
342    else
343      Result := CallNextEventHandler(ANextHandler, AEvent);
344  end;
345
346  // interactive design
347  if (EventKind = kEventMouseDown)
348  and Assigned(Widget.LCLObject)
349  and ((csDesigning in Widget.LCLObject.ComponentState) or (Widget is TCarbonDesignWindow))
350  and (GetCarbonMouseButton(AEvent) = 1) then
351  begin
352    P := GetMousePoint;
353    DesignControl := Widget.LCLObject.ControlAtPos(P,
354      [capfAllowDisabled, capfAllowWinControls, capfRecursive]);
355    if DesignControl = nil then
356      DesignControl := Widget.LCLObject;
357
358    if DesignControl is TWinControl then
359    begin
360      ClientPt := DesignControl.ScreenToClient(Widget.LCLObject.ClientToScreen(P));
361      ControlPt := DesignControl.ScreenToControl(Widget.LCLObject.ClientToScreen(P));
362
363      if (DesignControl as TWinControl).HandleAllocated then
364      begin
365        DesignWidget := TCarbonWidget((DesignControl as TWinControl).Handle);
366        if DesignWidget.IsDesignInteractive(ClientPt) then
367        begin
368          DesignView := DesignWidget.WidgetAtPos(ControlPt);
369          DesignPt := PointToHIPoint(ControlPt);
370          OSError(HIViewConvertPoint(DesignPt, DesignWidget.Widget, DesignView),
371            SName, 'HIViewConvertPoint');
372
373          ViewPart := 0;
374          OSError(HIViewGetPartHit(DesignView, DesignPt, ViewPart),
375            SName, 'HIViewGetPartHit');
376          OSError(HIViewSimulateClick(DesignView, ViewPart, GetCarbonMsgKeyState, nil),
377            SName, 'HIViewSimulateClick');
378        end;
379      end;
380    end;
381  end;
382end;
383
384{------------------------------------------------------------------------------
385  Name: CarbonWindow_KeyboardProc
386  Handles key events
387 ------------------------------------------------------------------------------}
388function CarbonWindow_KeyboardProc(ANextHandler: EventHandlerCallRef;
389  AEvent: EventRef;
390  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
391var
392  Control: ControlRef;      // the control we are dealing with
393                            // or the rootcontrol if none found
394  Widget: TCarbonWidget;    // the widget specific to the mouse event
395                            // or the window's widget if none found
396  KeyChar : char;           //Ascii char, when possible (xx_(SYS)CHAR)
397  VKKeyChar: char;          // Ascii char without modifiers
398  UTF8Character: TUTF8Char; //char to send via IntfUtf8KeyPress
399  UTF8VKCharacter: TUTF8Char; //char without modifiers, used for VK_ key value
400  VKKeyCode : word;         //VK_ code
401  SendChar : boolean;       //Should we send char?
402  IsSysKey: Boolean;        //Is alt (option) key down?
403  KeyData : PtrInt;         //Modifiers (ctrl, alt, mouse buttons...)
404  EventKind: UInt32;        //The kind of this event
405const
406  SName = 'CarbonWindow_KeyboardProc';
407  AGetEvent = 'GetEventParameter';
408  ASetEvent = 'SetEventParameter';
409
410  // See what changed in the modifiers flag so that we can emulate a keyup/keydown
411  // Note: this function assumes that only a bit of the flag can be modified at
412  // once
413  function EmulateModifiersDownUp : boolean;
414  var CurMod, diff : UInt32;
415  begin
416    Result:=false;
417    SendChar:=false;
418    if OSError(
419      GetEventParameter(AEvent, kEventParamKeyModifiers, typeUInt32, nil,
420        SizeOf(CurMod), nil, @CurMod), SName, AGetEvent,
421      'kEventParamKeyModifiers') then Exit;
422
423    //see what changed. we only care of bits 8 through 12
424    diff:=(PrevKeyModifiers xor CurMod) and $1F00;
425
426    //diff is now equal to the mask of the bit that changed, so we can determine
427    //if this change is a keydown (PrevKeyModifiers didn't have the bit set) or
428    //a keyup (PrevKeyModifiers had the bit set)
429    if (PrevKeyModifiers and diff)=0 then EventKind:=kEventRawKeyDown
430    else EventKind:=kEventRawKeyUp;
431
432    PrevKeyModifiers:=CurMod;
433
434    case diff of
435      0          : exit;  //nothing (that we cared of) changed
436      controlKey : VKKeyCode := VK_CONTROL; //command mapped to control
437      shiftKey   : VKKeyCode := VK_SHIFT;
438      alphaLock  : VKKeyCode := VK_CAPITAL; //caps lock
439      optionKey  : VKKeyCode := VK_MENU;    //option is alt
440      cmdKey     : VKKeyCode := VK_LWIN;    //meta... map to left Windows Key?
441      else begin
442        debugln(['CarbonWindow_KeyboardProc.EmulateModifiersDownUp TODO: more than one modifier changed ',diff]);
443        exit; //Error! More that one bit changed in the modifiers?
444      end;
445    end;
446    Result:=true;
447
448    {$IFDEF VerboseKeyboard}
449      DebugLn('[CarbonWindow_KeyboardProc.EmulateModifiersDownUp] VK =', DbgsVKCode(VKKeyCode));
450    {$ENDIF}
451  end;
452
453
454(*
455  Mac keycodes handling is not so straight. For an explanation, see
456  mackeycodes.inc
457  In this function, we do the following:
458   1) Get the raw keycode, if it is a known "non-printable" key, translate it
459      to a known VK_ keycode.
460      This will be reported via xx_KeyDown/KeyUP messages only, and we can stop
461      here.
462   2) else, we must send both KeyDown/KeyUp and IntfUTF8KeyPress/xx_(SYS)CHAR
463      So, get the unicode character and the "ascii" character (note: if it's
464      not a true ascii character (>127) use the Mac character).
465    2a) Try to determine a known VK_ keycode (e.g: VK_A, VK_SPACE and so on)
466    2b) If no VK_ keycode exists, use a dummy keycode to trigger LCL events
467        (see later in the code for a more in depth explanation)
468*)
469
470  function TranslateMacKeyCode : boolean;
471  var KeyCode, DeadKeys: UInt32;
472      TextLen : UInt32;
473      CharLen : integer;
474      widebuf: array[1..2] of widechar;
475      U: Cardinal;
476      Layout: UCKeyboardLayoutPtr;
477      KeyboardLayout: KeyboardLayoutRef;
478  begin
479    Result:=false;
480    SendChar:=false;
481    VKKeyCode:=VK_UNKNOWN;
482
483    KeyData:=GetCarbonMsgKeyState;
484    IsSysKey:=(GetCurrentEventKeyModifiers and cmdKey)>0;
485
486    if OSError(GetEventParameter(AEvent, kEventParamKeyCode, typeUInt32, nil,
487        Sizeof(KeyCode), nil, @KeyCode), SName, AGetEvent,
488      'kEventParamKeyCode') then Exit;
489
490    //non-printable keys (see mackeycodes.inc)
491    //for these keys, only send keydown/keyup (not char or UTF8KeyPress)
492    case KeyCode of
493      MK_F1       : VKKeyCode:=VK_F1;
494      MK_F2       : VKKeyCode:=VK_F2;
495      MK_F3       : VKKeyCode:=VK_F3;
496      MK_F4       : VKKeyCode:=VK_F4;
497      MK_F5       : VKKeyCode:=VK_F5;
498      MK_F6       : VKKeyCode:=VK_F6;
499      MK_F7       : VKKeyCode:=VK_F7;
500      MK_F8       : VKKeyCode:=VK_F8;
501      MK_F9       : VKKeyCode:=VK_F9;
502      MK_F10      : VKKeyCode:=VK_F10;
503      MK_F11      : VKKeyCode:=VK_F11;
504      MK_F12      : VKKeyCode:=VK_F12;
505      MK_F13      : VKKeyCode:=VK_F13;
506      MK_F14      : VKKeyCode:=VK_F14;
507      MK_F15      : VKKeyCode:=VK_F15;
508      MK_F16      : VKKeyCode:=VK_F16;
509      MK_F17      : VKKeyCode:=VK_F17;
510      MK_F18      : VKKeyCode:=VK_F18;
511      MK_F19      : VKKeyCode:=VK_F19;
512      MK_POWER    : VKKeyCode:=VK_SLEEP; //?
513      MK_TAB      : VKKeyCode:=VK_TAB; //strangely enough, tab is "non printable"
514      MK_HELP     : VKKeyCode:=VK_HELP;
515      MK_DEL      : VKKeyCode:=VK_DELETE;
516      MK_HOME     : VKKeyCode:=VK_HOME;
517      MK_END      : VKKeyCode:=VK_END;
518      MK_PAGUP    : VKKeyCode:=VK_PRIOR;
519      MK_PAGDN    : VKKeyCode:=VK_NEXT;
520      MK_UP       : VKKeyCode:=VK_UP;
521      MK_DOWN     : VKKeyCode:=VK_DOWN;
522      MK_LEFT     : VKKeyCode:= VK_LEFT;
523      MK_RIGHT    : VKKeyCode:= VK_RIGHT;
524      MK_CLEAR    : VKKeyCode:= VK_CLEAR;
525    end;
526
527    if VKKeyCode<>VK_UNKNOWN then
528    begin
529      //stop here, we won't send char or UTF8KeyPress
530      {$IFDEF VerboseKeyboard}
531       DebugLn('[TranslateMacKeyCode] non printable VK = ', DbgsVKCode(VKKeyCode));
532      {$ENDIF}
533      Result:=true;
534      exit;
535    end;
536
537    // get untranslated key (key without modifiers)
538    OSError(KLGetCurrentKeyboardLayout(KeyboardLayout{%H-}), SName, 'KLGetCurrentKeyboardLayout');
539    OSError(KLGetKeyboardLayoutProperty(KeyboardLayout, kKLuchrData, Layout{%H-}), SName, 'KLGetKeyboardLayoutProperty');
540    {$IFDEF VerboseKeyboard}
541    DebugLn('[Keyboard layout] UCHR layout = ', DbgS(Layout));
542    {$ENDIF}
543
544    TextLen:=0;
545    DeadKeys:=0;
546    UTF8VKCharacter:='';
547    VKKeyChar:=#0;
548    CharLen:=0;
549
550    if Layout <> nil then
551    begin
552      OSError(UCKeyTranslate(Layout^, KeyCode, kUCKeyActionDisplay,
553          0, LMGetKbdType,
554          kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @WideBuf[1]), SName, 'UCKeyTranslate');
555
556      if TextLen>0 then begin
557        u:=UTF16CharacterToUnicode(@WideBuf[1],CharLen);
558        if CharLen>0 then begin
559          UTF8VKCharacter:=UnicodeToUTF8(u);
560          if (UTF8VKCharacter<>'') and (ord(Utf8VKCharacter[1])<=127) then //It's (true) ascii.
561            VKKeyChar:=Utf8VKCharacter[1]
562          else //not ascii, get the Mac character.
563            OSError(
564              GetEventParameter(AEvent, kEventParamKeyMacCharCodes, typeChar, nil,
565                Sizeof(VKKeyChar), nil, @VKKeyChar), SName, AGetEvent,
566              'kEventParamKeyMacCharCodes');
567        end;
568      end;
569
570      TextLen := 0;
571
572      if IsSysKey then
573      begin // workaround for Command modifier suppressing shift
574        DeadKeys := 0;
575        OSError(UCKeyTranslate(Layout^, KeyCode, kUCKeyActionDisplay,
576            (GetCurrentEventKeyModifiers and not cmdkey) shr 8, LMGetKbdType,
577            kUCKeyTranslateNoDeadKeysMask, DeadKeys, 6, TextLen, @WideBuf[1]), SName, 'UCKeyTranslate');
578        {$IFDEF VerboseKeyboard}
579        debugln(['TranslateMacKeyCode IsSysKey: TextLen=',TextLen,' CharLen=',CharLen,' UTF8VKCharacter=',UTF8VKCharacter]);
580        {$ENDIF}
581      end;
582    end
583    else
584    begin
585      // uchr style keyboard layouts not always available - fall back to older style
586      OSError(KLGetKeyboardLayoutProperty(KeyboardLayout, kKLKCHRData, Layout), SName, 'KLGetKeyboardLayoutProperty');
587      {$IFDEF VerboseKeyboard}
588       DebugLn('[Keyboard layout] KCHR layout = ', DbgS(Layout));
589      {$ENDIF}
590      VKKeyChar := Char(KeyTranslate(Layout, KeyCode, DeadKeys) and 255);
591      { TODO: workaround for Command modifier suppressing shift? }
592    end;
593
594    {$IFDEF VerboseKeyboard}
595    debugln(['TranslateMacKeyCode TextLen=',TextLen,' CharLen=',CharLen,' UTF8VKCharacter=',UTF8VKCharacter,' VKKeyChar=',DbgStr(VKKeyChar)]);
596    {$ENDIF}
597
598    //printable keys
599    //for these keys, send char or UTF8KeyPress
600
601    if TextLen = 0 then
602    begin
603      if OSError(
604        GetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText, nil,
605          6, @TextLen, @WideBuf[1]), SName, AGetEvent, 'kEventParamKeyUnicodes') then Exit;
606    end;
607
608    if TextLen>0 then
609    begin
610      SendChar:=true;
611
612      u:=UTF16CharacterToUnicode(@WideBuf[1],CharLen);
613      if CharLen=0 then exit;
614      UTF8Character:=UnicodeToUTF8(u);
615
616      if (UTF8Character<>'') and (ord(Utf8Character[1])<=127) then //It's (true) ascii.
617        KeyChar:=Utf8Character[1]
618      else //not ascii, get the Mac character.
619        if OSError(
620          GetEventParameter(AEvent, kEventParamKeyMacCharCodes, typeChar, nil,
621            Sizeof(KeyChar), nil, @KeyChar), SName, AGetEvent,
622          'kEventParamKeyMacCharCodes') then Exit;
623
624      {$IFDEF VerboseKeyboard}
625      debugln(['TranslateMacKeyCode printable key: TextLen=',TextLen,' UTF8Character=',UTF8Character,' KeyChar=',DbgStr(KeyChar),' VKKeyChar=',DbgStr(VKKeyChar)]);
626      {$ENDIF}
627
628      // the VKKeyCode is independent of the modifier
629      // => use the VKKeyChar instead of the KeyChar
630      case VKKeyChar of
631        'a'..'z': VKKeyCode:=VK_A+ord(VKKeyChar)-ord('a');
632        'A'..'Z': VKKeyCode:=ord(VKKeyChar);
633        #27     : VKKeyCode:=VK_ESCAPE;
634        #8      : VKKeyCode:=VK_BACK;
635        ' '     : VKKeyCode:=VK_SPACE;
636        #13     : VKKeyCode:=VK_RETURN;
637        '0'..'9':
638          case KeyCode of
639            MK_NUMPAD0: VKKeyCode:=VK_NUMPAD0;
640            MK_NUMPAD1: VKKeyCode:=VK_NUMPAD1;
641            MK_NUMPAD2: VKKeyCode:=VK_NUMPAD2;
642            MK_NUMPAD3: VKKeyCode:=VK_NUMPAD3;
643            MK_NUMPAD4: VKKeyCode:=VK_NUMPAD4;
644            MK_NUMPAD5: VKKeyCode:=VK_NUMPAD5;
645            MK_NUMPAD6: VKKeyCode:=VK_NUMPAD6;
646            MK_NUMPAD7: VKKeyCode:=VK_NUMPAD7;
647            MK_NUMPAD8: VKKeyCode:=VK_NUMPAD8;
648            MK_NUMPAD9: VKKeyCode:=VK_NUMPAD9
649            else VKKeyCode:=ord(VKKeyChar);
650          end;
651        else
652        case KeyCode of
653          MK_PADDIV  : VKKeyCode:=VK_DIVIDE;
654          MK_PADMULT : VKKeyCode:=VK_MULTIPLY;
655          MK_PADSUB  : VKKeyCode:=VK_SUBTRACT;
656          MK_PADADD  : VKKeyCode:=VK_ADD;
657          MK_PADDEC  : VKKeyCode:=VK_DECIMAL;
658          MK_PADEQUALS: VKKeyCode:=VK_OEM_PLUS;
659          MK_PADENTER:
660            begin
661              VKKeyCode:=VK_RETURN;
662              VKKeyChar:=#13;
663              UTF8Character:=VKKeyChar;
664            end;
665          MK_TILDE: VKKeyCode := VK_OEM_3;
666          MK_MINUS: VKKeyCode := VK_OEM_MINUS;
667          MK_EQUAL: VKKeyCode := VK_OEM_PLUS;
668          MK_BACKSLASH:    VKKeyCode := VK_OEM_5;
669          MK_LEFTBRACKET:  VKKeyCode := VK_OEM_4;
670          MK_RIGHTBRACKET: VKKeyCode := VK_OEM_6;
671          MK_SEMICOLON:    VKKeyCode := VK_OEM_1;
672          MK_QUOTE:  VKKeyCode := VK_OEM_7;
673          MK_COMMA:  VKKeyCode := VK_OEM_COMMA;
674          MK_PERIOD: VKKeyCode := VK_OEM_PERIOD;
675          MK_SLASH:  VKKeyCode := VK_OEM_2;
676        end;
677      end;
678
679      if VKKeyCode=VK_UNKNOWN then
680      begin
681        // There is no known VK_ code for this characther. Use a dummy keycode
682        // (E8, which is unused by Windows) so that KeyUp/KeyDown events will be
683        // triggered by LCL.
684        // Note: we can't use the raw mac keycode, since it could collide with
685        // well known VK_ keycodes (e.g on my italian ADB keyboard, keycode for
686        // "&egrave;" is 33, which is the same as VK_PRIOR)
687        VKKeyCode:=$E8;
688      end;
689
690      {$IFDEF VerboseKeyboard}
691      DebugLn('[TranslateMacKeyCode] VKKeyCode=', DbgsVKCode(VKKeyCode), ' Utf8="',
692         UTF8Character, '" VKKeyChar="', DbgStr(VKKeyChar), '" KeyChar="',DbgStr(KeyChar),'"' );
693      {$ENDIF}
694
695      Result := True;
696    end
697    else DebugLn('[TranslateMacKeyCode] Error Unable to get Unicode char RawKeyCode = ',
698      DbgsVKCode(KeyCode));
699  end;
700
701
702  function LCLCharToMacEvent(const AUTF8Char: AnsiString): Boolean;
703  var
704    WideBuf: WideString;
705  begin
706    if AUTF8Char='' then Exit;
707    // only one character should be used
708    WideBuf:={%H-}UTF8Encode(UTF8Copy(AUTF8Char, 1,1));
709    Result:=(length(WideBuf)>0) and
710      (not OSError(SetEventParameter(AEvent, kEventParamKeyUnicodes, typeUnicodeText,
711        length(WideBuf)*2, @WideBuf[1]), SName, ASetEvent, 'kEventParamKeyUnicodes'));
712  end;
713
714
715  function HandleRawKeyDownEvent: OSStatus;
716  var
717    KeyMsg: TLMKeyDown;
718    CharMsg: TLMChar;
719    OrigChar: AnsiString;
720
721    Menu: MenuRef;
722    MenuIdx: MenuItemIndex;
723  begin
724    Result:=EventNotHandledErr;
725    {$IFDEF VerboseKeyboard}
726      DebugLN('[HandleRawKeyDownEvent] Widget.LCLObject=', DbgSName(Widget.LCLObject));
727    {$ENDIF}
728
729    // create the CN_KEYDOWN message
730    FillChar(KeyMsg{%H-}, SizeOf(KeyMsg), 0);
731    if IsSysKey then KeyMsg.Msg := CN_SYSKEYDOWN
732    else KeyMsg.Msg := CN_KEYDOWN;
733    KeyMsg.KeyData := KeyData;
734    KeyMsg.CharCode := VKKeyCode;
735
736    // is the key combination help key (Cmd + ?)
737    if SendChar and IsSysKey and (UTF8Character = '?') then
738    begin
739      //DebugLn('Application.ShowHelpForObject');
740      Application.ShowHelpForObject(Widget.LCLObject);
741    end;
742
743    // widget can filter some keys from being send to Carbon control
744    if Widget.FilterKeyPress(IsSysKey, UTF8Character) then Result := noErr;
745
746    //Send message to LCL
747    if VKKeyCode<>VK_UNKNOWN then
748    begin
749      if (DeliverMessage(Widget.LCLObject, KeyMsg) <> 0) or (KeyMsg.CharCode=VK_UNKNOWN) then
750      begin
751        // the LCL handled the key
752        {$IFDEF VerboseKeyboard}
753          DebugLn('[HandleRawKeyDownEvent] LCL handled CN_KEYDOWN, exiting');
754        {$ENDIF}
755
756        NotifyApplicationUserInput(Widget.LCLObject, KeyMsg.Msg);
757        Result := noErr;
758        Exit;
759      end;
760
761      //Here is where we (interface) can do something with the key
762      //Call the standard handler. Only Up/Down events are notified.
763      Widget.ProcessKeyEvent(KeyMsg);
764
765      //Send a LM_(SYS)KEYDOWN
766      if IsSysKey then KeyMsg.Msg := LM_SYSKEYDOWN
767      else KeyMsg.Msg := LM_KEYDOWN;
768      if (DeliverMessage(Widget.LCLObject, KeyMsg) <> 0) or (KeyMsg.CharCode=VK_UNKNOWN) then
769      begin
770        // the LCL handled the key
771        {$IFDEF VerboseKeyboard}
772          DebugLn('[HandleRawKeyDownEvent] LCL handled LM_KEYDOWN, exiting');
773        {$ENDIF}
774        //Result already set by CallNextEventHandler
775
776        NotifyApplicationUserInput(Widget.LCLObject, KeyMsg.Msg);
777        Exit;
778      end;
779    end;
780
781    //We should send a character
782    if SendChar then
783    begin
784      // send the UTF8 keypress
785      OrigChar:=UTF8Character;
786      if TWinControl(Widget.LCLObject).IntfUTF8KeyPress(UTF8Character,1,IsSysKey) then
787      begin
788        // the LCL has handled the key
789        {$IFDEF VerboseKeyboard}
790          Debugln('[HandleRawKeyDownEvent] LCL handled IntfUTF8KeyPress, exiting');
791        {$ENDIF}
792        if Result=EventNotHandledErr then
793          Result := noErr;
794        Exit;
795      end;
796      if OrigChar<>UTF8Character then
797        LCLCharToMacEvent(UTF8Character);
798
799      // create the CN_CHAR / CN_SYSCHAR message
800      FillChar(CharMsg{%H-}, SizeOf(CharMsg), 0);
801      if IsSysKey then CharMsg.Msg := CN_SYSCHAR
802      else CharMsg.Msg := CN_CHAR;
803      CharMsg.KeyData := KeyData;
804      CharMsg.CharCode := ord(KeyChar);
805
806      //Send message to LCL
807      if (DeliverMessage(Widget.LCLObject, CharMsg) <> 0) or (CharMsg.CharCode=VK_UNKNOWN) then
808      begin
809        // the LCL handled the key
810        {$IFDEF VerboseKeyboard}
811          Debugln('[HandleRawKeyDownEvent] LCL handled CN_CHAR, exiting');
812        {$ENDIF}
813        if Result=EventNotHandledErr then
814          Result := noErr;
815
816        NotifyApplicationUserInput(Widget.LCLObject, CharMsg.Msg);
817        Exit;
818      end;
819      if CharMsg.CharCode<>ord(KeyChar) then
820        LCLCharToMacEvent(Char(CharMsg.CharCode));
821
822      if Result<>noErr then
823        Result:=CallNextEventHandler(ANextHandler, AEvent);
824
825      if IsMenuKeyEvent(nil, GetCurrentEvent, kMenuEventQueryOnly, @Menu, @MenuIdx) then
826      begin
827        // re-handling menu
828        SendMenuActivate(Menu, MenuIdx);
829      end;
830
831      //Send a LM_(SYS)CHAR
832      if IsSysKey then
833      begin
834        //CharMsg.Msg := LM_SYSCHAR
835        // Do not send LM_SYSCHAR message - workaround for disabling
836        // accelerators like "Cmd + C" for &Caption
837        Exit;
838      end
839      else CharMsg.Msg := LM_CHAR;
840
841      if DeliverMessage(Widget.LCLObject, CharMsg) <> 0 then
842      begin
843        // the LCL handled the key
844        {$IFDEF VerboseKeyboard}
845          Debugln('[HandleRawKeyDownEvent] LCL handled LM_CHAR, exiting');
846        {$ENDIF}
847        if Result=EventNotHandledErr then
848          Result := noErr;
849
850        NotifyApplicationUserInput(Widget.LCLObject, CharMsg.Msg);
851        Exit;
852      end;
853    end;
854  end;
855
856  function HandleRawKeyUpEvent : OSStatus;
857  var
858    KeyMsg: TLMKeyUp;
859  begin
860    Result:=EventNotHandledErr;
861    {$IFDEF VerboseKeyboard}
862      DebugLN('[HandleRawKeyUpEvent] Widget.LCLObject=',DbgSName(Widget.LCLObject));
863    {$ENDIF}
864
865    // create the CN_KEYUP message
866    FillChar(KeyMsg{%H-}, SizeOf(KeyMsg), 0);
867    if IsSysKey then KeyMsg.Msg := CN_SYSKEYUP
868    else KeyMsg.Msg := CN_KEYUP;
869    KeyMsg.KeyData := KeyData;
870    KeyMsg.CharCode := VKKeyCode;
871
872    //Send message to LCL
873    if VKKeyCode<>VK_UNKNOWN then
874    begin
875      if (DeliverMessage(Widget.LCLObject, KeyMsg) <> 0) or (KeyMsg.CharCode=VK_UNKNOWN) then
876      begin
877        // the LCL has handled the key
878        {$IFDEF VerboseKeyboard}
879          Debugln('[HandleRawKeyUpEvent] LCL handled CN_KEYUP, exiting');
880        {$ENDIF}
881        Result := noErr;
882
883        NotifyApplicationUserInput(Widget.LCLObject, KeyMsg.Msg);
884        Exit;
885      end;
886
887      //Here is where we (interface) can do something with the key
888      //Call the standard handler.
889      Widget.ProcessKeyEvent(KeyMsg);
890      Result:=CallNextEventHandler(ANextHandler, AEvent);
891
892      //Send a LM_(SYS)KEYUP
893      if IsSysKey then KeyMsg.Msg := LM_SYSKEYUP
894      else KeyMsg.Msg := LM_KEYUP;
895      if DeliverMessage(Widget.LCLObject, KeyMsg) <> 0 then
896      begin
897        // the LCL handled the key
898        {$IFDEF VerboseKeyboard}
899          Debugln('[HandleRawKeyUpEvent] LCL handled LM_KEYUP, exiting');
900        {$ENDIF}
901        if Result=EventNotHandledErr then
902          Result := noErr;
903
904        NotifyApplicationUserInput(Widget.LCLObject, KeyMsg.Msg);
905        Exit;
906      end;
907    end;
908
909  end;
910
911begin
912  Result := EventNotHandledErr;
913
914  Control := nil;
915  if Assigned(AWidget.FPopupWin) then
916  begin
917    if OSError(GetKeyboardFocus(AWidget.FPopupWin, Control), SName, SGetKeyboardFocus) then Exit;
918    Widget := AWidget;
919  end
920  else
921  begin
922    if OSError(GetKeyboardFocus( TCarbonWindow(AWidget).fWindowRef, Control), SName,
923      SGetKeyboardFocus) then Exit;
924    if Control = nil then Control := AWidget.Content;
925
926    // if a control other than root is found, send the message
927    // to the control instead of the window
928    // if a lower control without widget is found, use its parent
929    Widget := nil;
930    while Control <> AWidget.Content do
931    begin
932      Widget := GetCarbonControl(Pointer(Control));
933      if Widget <> nil then Break;
934      Control := HIViewGetSuperview(Control);
935    end;
936    if (Widget = nil) or (Control = AWidget.Content) then Widget := AWidget;
937  end;
938
939  Widget.BeginEventProc;
940  try
941
942    EventKind := GetEventKind(AEvent);
943    if EventKind = kEventRawKeyModifiersChanged then
944    begin
945      if not EmulateModifiersDownUp then Exit;
946    end
947    else
948      if not TranslateMacKeyCode then
949      begin
950        Debugln('[CarbonWindow_KeyboardProc] ***WARNING: TranslateMacKeyCode failed***');
951        Exit;
952      end;
953
954    case EventKind of
955      kEventRawKeyDown  : Result := HandleRawKeyDownEvent;
956      kEventRawKeyRepeat: Result := HandleRawKeyDownEvent;
957      kEventRawKeyUp    : Result := HandleRawKeyUpEvent;
958    end;
959  finally
960    Widget.EndEventProc;
961  end;
962end;
963
964{------------------------------------------------------------------------------
965  Name: CarbonWindow_ActivateProc
966  Handles window activating/deactivating
967 ------------------------------------------------------------------------------}
968function CarbonWindow_ActivateProc(ANextHandler: EventHandlerCallRef;
969  AEvent: EventRef;
970  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
971var
972  DoActivate: Boolean;
973  EventKind: UInt32;
974  Control: ControlRef;
975  FocusWidget: TCarbonWidget;
976begin
977  {$IFDEF VerboseWindowEvent}
978    DebugLn('CarbonWindow_ActivateProc ', DbgSName(AWidget.LCLObject));
979  {$ENDIF}
980  Result := CallNextEventHandler(ANextHandler, AEvent);
981
982  EventKind := GetEventKind(AEvent);
983  case EventKind of
984    kEventWindowActivated:
985      begin
986        DoActivate:=true;
987        if (AWidget.LCLObject is TCustomForm) then
988        begin
989          if (TCustomForm(AWidget.LCLObject).Menu <> nil) and
990             (TCustomForm(AWidget.LCLObject).Menu.HandleAllocated) then
991            CarbonWidgetSet.SetRootMenu(TCustomForm(AWidget.LCLObject).Menu.Handle)
992          else
993            CarbonWidgetSet.SetRootMenu(0);
994        end;
995      end;
996    kEventWindowDeactivated: DoActivate:=false;
997  else
998    DebugLn('CarbonWindow_ActivateProc invalid event kind: ' + DbgS(EventKind));
999    Exit;
1000  end;
1001
1002  if DoActivate
1003  then LCLSendActivateMsg(AWidget.LCLObject, WA_ACTIVE, false)
1004  else LCLSendActivateMsg(AWidget.LCLObject, WA_INACTIVE, false);
1005
1006  // force set and kill focus of focused control
1007  Control := nil;
1008  OSError(GetKeyboardFocus(TCarbonWindow(AWidget).fWindowRef, Control), 'CarbonWindow_ActivateProc', SGetKeyboardFocus);
1009  if Control <> nil
1010  then FocusWidget := GetCarbonControl(Control)
1011  else FocusWidget := nil;
1012
1013  // Focusing the form without controls
1014  if (FocusWidget = nil) and DoActivate then FocusWidget:=AWidget;
1015
1016  if FocusWidget <> nil then
1017  begin
1018    if DoActivate
1019    then FocusWidget.FocusSet
1020    else FocusWidget.FocusKilled;
1021  end;
1022end;
1023
1024{------------------------------------------------------------------------------
1025  Name: CarbonWindow_ShowWindow
1026  Handles window minimizing/maximizing/restoring
1027 ------------------------------------------------------------------------------}
1028function CarbonWindow_ShowWindow(ANextHandler: EventHandlerCallRef;
1029  AEvent: EventRef;
1030  AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
1031var
1032  EventKind: UInt32;
1033  WidgetBounds: TRect;
1034  Kind: Integer;
1035begin
1036  {$IFDEF VerboseWindowEvent}
1037    DebugLn('CarbonWindow_ShowWindow ', DbgSName(AWidget.LCLObject));
1038  {$ENDIF}
1039
1040  Result := CallNextEventHandler(ANextHandler, AEvent);
1041
1042  EventKind := GetEventKind(AEvent);
1043
1044  Kind := -1;
1045  case EventKind of
1046  kEventWindowCollapsed: Kind := SIZE_MINIMIZED;
1047  kEventWindowExpanded, kEventWindowZoomed:
1048    begin
1049      if IsWindowInStandardState(TCarbonWindow(AWidget).fWindowRef, nil, nil) then
1050        Kind := SIZE_MAXIMIZED
1051      else
1052        Kind := SIZE_RESTORED;
1053    end;
1054  else
1055    DebugLn('CarbonWindow_ShowWindow invalid event kind: ' + DbgS(EventKind));
1056    Exit;
1057  end;
1058
1059  {$IFDEF VerboseWindowEvent}
1060    DebugLn('CarbonWindow_ShowWindow Event: ', DbgS(EventKind) + ' Kind: ' +
1061      DbgS(Kind) + ' Showing: ' + DbgS(AWidget.LCLObject.Showing));
1062  {$ENDIF}
1063
1064  if Kind >= 0 then
1065  begin
1066    AWidget.GetBounds(WidgetBounds{%H-});
1067    LCLSendSizeMsg(AWidget.LCLObject, WidgetBounds.Right - WidgetBounds.Left,
1068      WidgetBounds.Bottom - WidgetBounds.Top, Size_SourceIsInterface or Kind);
1069  end;
1070end;
1071
1072{ TCarbonWindow }
1073
1074procedure TCarbonWindow.BoundsChanged;
1075begin
1076  inherited BoundsChanged;
1077
1078{  if Assigned(fWindowRef) then begin
1079    GetClientRect(r);
1080    hr.origin := GetHIPoint(0,0);
1081    hr.size := GetHISize(r.Right - r.Left, r.Bottom - r.Top);
1082    HIViewSetFrame(FScrollView, hr);
1083  end;}
1084end;
1085
1086procedure TCarbonWindow.RegisterWindowEvents;
1087var
1088  MouseSpec: array [0..6] of EventTypeSpec;
1089  TmpSpec: EventTypeSpec;
1090  KeySpecs: array[0..3] of EventTypeSpec;
1091  ActivateSpecs: array[0..1] of EventTypeSpec;
1092  ShowWindowSpecs: array[0..2] of EventTypeSpec;
1093  WinContent: HIViewRef;
1094begin
1095  // Window Events
1096
1097  TmpSpec := MakeEventSpec(kEventClassWindow, kEventWindowClose);
1098  InstallWindowEventHandler(fWindowRef,
1099    RegisterEventHandler(@CarbonWindow_Close),
1100    1, @TmpSpec, Pointer(Self), nil);
1101
1102  TmpSpec := MakeEventSpec(kEventClassWindow, kEventWindowClosed);
1103  InstallWindowEventHandler(fWindowRef,
1104    RegisterEventHandler(@CarbonCommon_Dispose),
1105    1, @TmpSpec, Pointer(Self), nil);
1106
1107  MouseSpec[0].eventClass := kEventClassMouse;
1108  MouseSpec[0].eventKind := kEventMouseDown;
1109  MouseSpec[1].eventClass := kEventClassMouse;
1110  MouseSpec[1].eventKind := kEventMouseUp;
1111  MouseSpec[2].eventClass := kEventClassMouse;
1112  MouseSpec[2].eventKind := kEventMouseMoved;
1113  MouseSpec[3].eventClass := kEventClassMouse;
1114  MouseSpec[3].eventKind := kEventMouseDragged;
1115  MouseSpec[4].eventClass := kEventClassMouse;
1116  MouseSpec[4].eventKind := kEventMouseEntered;
1117  MouseSpec[5].eventClass := kEventClassMouse;
1118  MouseSpec[5].eventKind := kEventMouseExited;
1119  MouseSpec[6].eventClass := kEventClassMouse;
1120  MouseSpec[6].eventKind := kEventMouseWheelMoved;
1121
1122  InstallWindowEventHandler(fWindowRef,
1123    RegisterEventHandler(@CarbonWindow_MouseProc),
1124    7, @MouseSpec[0], Pointer(Self), nil);
1125
1126  KeySpecs[0].eventClass := kEventClassKeyboard;
1127  KeySpecs[0].eventKind := kEventRawKeyDown;
1128  KeySpecs[1].eventClass := kEventClassKeyboard;
1129  KeySpecs[1].eventKind := kEventRawKeyRepeat;
1130  KeySpecs[2].eventClass := kEventClassKeyboard;
1131  KeySpecs[2].eventKind := kEventRawKeyUp;
1132  KeySpecs[3].eventClass := kEventClassKeyboard;
1133  KeySpecs[3].eventKind := kEventRawKeyModifiersChanged;
1134
1135  InstallWindowEventHandler(fWindowRef,
1136    RegisterEventHandler(@CarbonWindow_KeyboardProc),
1137    4, @KeySpecs[0], Pointer(Self), nil);
1138
1139  ActivateSpecs[0].eventClass := kEventClassWindow;
1140  ActivateSpecs[0].eventKind := kEventWindowActivated;
1141  ActivateSpecs[1].eventClass := kEventClassWindow;
1142  ActivateSpecs[1].eventKind := kEventWindowDeactivated;
1143
1144  InstallWindowEventHandler(fWindowRef,
1145    RegisterEventHandler(@CarbonWindow_ActivateProc),
1146    2, @ActivateSpecs[0], Pointer(Self), nil);
1147
1148  ShowWindowSpecs[0].eventClass := kEventClassWindow;
1149  ShowWindowSpecs[0].eventKind := kEventWindowCollapsed;
1150  ShowWindowSpecs[1].eventClass := kEventClassWindow;
1151  ShowWindowSpecs[1].eventKind := kEventWindowExpanded;
1152  ShowWindowSpecs[2].eventClass := kEventClassWindow;
1153  ShowWindowSpecs[2].eventKind := kEventWindowZoomed;
1154
1155  InstallWindowEventHandler(fWindowRef,
1156    RegisterEventHandler(@CarbonWindow_ShowWindow),
1157    3, @ShowWindowSpecs[0], Pointer(Self), nil);
1158
1159  TmpSpec := MakeEventSpec(kEventClassWindow, kEventWindowBoundsChanged);
1160  InstallWindowEventHandler(fWindowRef,
1161    RegisterEventHandler(@CarbonCommon_BoundsChanged),
1162    1, @TmpSpec, Pointer(Self), nil);
1163
1164  // cursor change
1165  TmpSpec := MakeEventSpec(kEventClassWindow, kEventWindowCursorChange);
1166  InstallWindowEventHandler(fWindowRef,
1167    RegisterEventHandler(@CarbonCommon_CursorChange),
1168    1, @TmpSpec, Pointer(Self), nil);
1169
1170  // user messages
1171  TmpSpec := MakeEventSpec(LCLCarbonEventClass, LCLCarbonEventKindUser);
1172  InstallWindowEventHandler(fWindowRef,
1173    RegisterEventHandler(@CarbonCommon_User),
1174    1, @TmpSpec, Pointer(Self), nil);
1175
1176  // paint content message
1177  if (HIViewFindByID( HIViewGetRoot(fWindowRef), kHIViewWindowContentID, WinContent{%H-}) = noErr) then
1178  begin
1179    TmpSpec := MakeEventSpec(kEventClassControl, kEventControlDraw);
1180    InstallControlEventHandler(WinContent,
1181      RegisterEventHandler(@CarbonWindow_ContentDraw),
1182      1, @TmpSpec, Pointer(Self), nil);
1183  end;
1184end;
1185
1186procedure TCarbonWindow.CreateWindow(const AParams: TCreateParams);
1187var
1188  AWindow: WindowRef;
1189  NewWindowClass: Integer;
1190  GroupClass: Integer;
1191  MinSize, MaxSize: HISize;
1192  Attributes: WindowAttributes;
1193begin
1194  // apply appropriate form style and form border style
1195  FSheetWin := nil;
1196  if csDesigning in LCLObject.ComponentState then
1197  begin
1198    GroupClass := kDocumentWindowClass;
1199    Attributes := kWindowInWindowMenuAttribute or
1200      GetBorderWindowAttrs(bsSizeable, [biMaximize, biMinimize, biSystemMenu]);
1201  end
1202  else
1203  begin
1204    Attributes := 0;
1205    case (LCLObject as TCustomForm).FormStyle of
1206    fsStayOnTop, fsSplash:
1207      GroupClass := kFloatingWindowClass;
1208    fsSystemStayOnTop:
1209      GroupClass := kUtilityWindowClass;
1210    else
1211      GroupClass := kDocumentWindowClass;
1212      Attributes := kWindowInWindowMenuAttribute;
1213    end;
1214    Attributes := Attributes or
1215      GetBorderWindowAttrs((LCLObject as TCustomForm).BorderStyle,
1216        (LCLObject as TCustomForm).BorderIcons);
1217    {case NewWindowClass of
1218      kMovableModalWindowClass:
1219        Attributes := Attributes and (not kWindowInWindowMenuAttribute);
1220      kFloatingWindowClass:
1221        Attributes := Attributes and (not (kWindowInWindowMenuAttribute or kWindowCollapseBoxAttribute));
1222    end;}
1223    if CREATESHEETWINDOW = PtrUInt(LCLObject) then
1224    begin
1225      CREATESHEETWINDOW := 0;
1226      GroupClass := kSheetWindowClass;
1227    end;
1228  end;
1229
1230  //DebugLn('TCarbonWindow.CreateWidget ' + DbgS(ParamsToCarbonRect(AParams)));
1231
1232  if GroupClass = kSheetWindowClass then
1233  begin
1234    NewWindowClass := GroupClass;
1235    Attributes := kWindowCompositingAttribute or kWindowStandardHandlerAttribute;
1236  end else
1237  begin
1238    NewWindowClass:=kDocumentWindowClass;
1239    Attributes := Attributes or kWindowCompositingAttribute or kWindowStandardHandlerAttribute
1240      or kWindowLiveResizeAttribute;
1241  end;
1242
1243  // Makes the window look good in Retina displays
1244  Attributes := Attributes or kWindowFrameworkScaledAttribute;
1245
1246  if OSError(
1247    CreateNewWindow(NewWindowClass,
1248      Attributes, GetCarbonRect(0, 0, 0, 0), AWindow{%H-}),
1249    Self, SCreateWidget, 'CreateNewWindow') then
1250  begin
1251    DebugLn('Unable to create a window with selected class '+IntToStr(NewWindowClass)+ ', and attributes,'+IntToStr(Attributes)+', fallback to kDocumentWindowClass');
1252    if OSError(CreateNewWindow(kDocumentWindowClass,
1253      Attributes, GetCarbonRect(0, 0, 0, 0), AWindow),
1254    Self, SCreateWidget, 'CreateNewWindow') then RaiseCreateWidgetError(LCLObject);
1255  end;
1256
1257  fWindowRef := AWindow;
1258
1259  OSError(
1260    SetWindowGroup(fWindowRef, GetWindowGroupOfClass(GroupClass)), Self,
1261    SCreateWidget, 'SetWindowGroup');
1262
1263  // creating wrapped views
1264  if OSError(
1265    HIViewFindByID(HIViewGetRoot(fWindowRef), kHIViewWindowContentID, fWinContent),
1266    Self, SCreateWidget, 'HIViewGetRoot') then RaiseCreateWidgetError(LCLObject);
1267
1268  OSError(
1269    SetWindowProperty(AWindow, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
1270    Self, SCreateWidget, 'SetWindowProperty');
1271  OSError(
1272    SetControlProperty(fWinContent, LAZARUS_FOURCC, WIDGETINFO_FOURCC, SizeOf(Self), @Self),
1273    Self, SCreateWidget, SSetControlProp);
1274
1275  SetBounds(LCLObject.BoundsRect);
1276  SetText(AParams.Caption);
1277  //DebugLn('TCarbonWindow.CreateWidget succeeds');
1278  SetColor(LCLObject.Color);
1279
1280  MinSize.width := LCLObject.Constraints.EffectiveMinWidth;
1281  MinSize.height := LCLObject.Constraints.EffectiveMinHeight;
1282  MaxSize.width := LCLObject.Constraints.EffectiveMaxWidth;
1283  MaxSize.height := LCLObject.Constraints.EffectiveMaxHeight;
1284  if MaxSize.width <= 0 then MaxSize.width := 10000;
1285  if MaxSize.height <= 0 then MaxSize.height := 10000;
1286
1287  OSError(SetWindowResizeLimits(AWindow, @MinSize, @MaxSize), Self, SCreateWidget,
1288    'SetWindowResizeLimits');
1289end;
1290
1291{------------------------------------------------------------------------------
1292  Method:  TCarbonWindow.RegisterEvents
1293
1294  Registers event handlers for window and its content area
1295 ------------------------------------------------------------------------------}
1296procedure TCarbonWindow.RegisterEvents;
1297begin
1298  inherited;
1299end;
1300
1301procedure SetClientAlign(Child, Parent: HIViewRef; FullAlign: Boolean);
1302var
1303  Layout: HILayoutInfo;
1304begin
1305  HIViewGetLayoutInfo(Child, Layout{%H-});
1306  if FullAlign then
1307  begin
1308    Layout.binding.left.kind  := kHILayoutBindLeft;
1309    Layout.binding.right.kind := kHILayoutBindRight;
1310    Layout.binding.top.kind    := kHILayoutBindTop;
1311    Layout.binding.bottom.kind := kHILayoutBindBottom;
1312  end else
1313  begin
1314    Layout.binding.left.kind  := kHILayoutBindNone;
1315    Layout.binding.right.kind := kHILayoutBindNone;
1316    Layout.binding.top.kind    := kHILayoutBindNone;
1317    Layout.binding.bottom.kind := kHILayoutBindNone;
1318  end;
1319  Layout.binding.left.toView := Parent;
1320  Layout.binding.right.toView := Parent;
1321  Layout.binding.top.toView := Parent;
1322  Layout.binding.bottom.toView := Parent;
1323  HIViewSetLayoutInfo(Child, Layout);
1324end;
1325
1326{------------------------------------------------------------------------------
1327  Method:  TCarbonWindow.CreateWidget
1328  Params:  AParams - Creation parameters
1329
1330  Creates Carbon window
1331 ------------------------------------------------------------------------------}
1332procedure TCarbonWindow.CreateWidget(const AParams: TCreateParams);
1333var
1334  Params  : TCreateParams;
1335begin
1336  CreateWindow(AParams);
1337  RegisterWindowEvents;
1338
1339  Params := AParams;
1340  Params.X := 0;
1341  Params.Y := 0;
1342  inherited CreateWidget(Params);
1343
1344  HIViewAddSubview(fWinContent, fScrollView);
1345  SetClientAlign(fScrollView, fWinContent, true);
1346  HIViewSetVisible(fScrollView, true);
1347end;
1348
1349{------------------------------------------------------------------------------
1350  Method:  TCarbonWindow.DestroyWidget
1351
1352  Override to do some clean-up
1353 ------------------------------------------------------------------------------}
1354procedure TCarbonWindow.DestroyWidget;
1355begin
1356  if Assigned(fWindowRef) then begin
1357    DisposeWindow(fWindowRef);
1358    fWindowRef := nil;
1359    fWinContent := nil;
1360    fHiddenWin := nil;
1361  end;
1362  inherited;
1363  //Widget := nil;
1364end;
1365
1366function TCarbonWindow.GetPreferredSize: TPoint;
1367const
1368  MinWinSize = 20;
1369begin
1370  //todo: find a proper way to determine prefered window size
1371  //      by default Carbon returns a height too large
1372  Result.x:=MinWinSize;
1373  Result.y:=MinWinSize;
1374end;
1375
1376{------------------------------------------------------------------------------
1377  Method:  TCarbonWindow.AddToWidget
1378  Params:  AParent - Parent widget
1379
1380  Adds window to parent widget
1381 ------------------------------------------------------------------------------}
1382procedure TCarbonWindow.AddToWidget(AParent: TCarbonWidget);
1383begin
1384  if Assigned(AParent) then
1385  begin
1386    fHiddenWin := fWindowRef;
1387    fWindowRef := nil;
1388    if IsWindowVisible(fHiddenWin) then HideWindow(fHiddenWin);
1389    OSError(HIViewAddSubview(AParent.Content, FScrollView), Self, 'AddToWidget', SViewAddView);
1390    AParent.ControlAdded;
1391    SetClientAlign(FScrollView, fWinContent, false);
1392  end else begin
1393    if IsVisible then
1394    begin
1395      ShowWindow(fHiddenWin);
1396      OSError(HIViewAddSubview(fWinContent, FScrollView), Self, 'AddToWidget', SViewAddView);
1397    end;
1398    SetClientAlign(FScrollView, fWinContent, true);
1399    fWindowRef := fHiddenWin;
1400  end;
1401end;
1402
1403{------------------------------------------------------------------------------
1404  Method:  TCarbonWindow.GetMousePos
1405  Returns: The position of mouse cursor in local coordinates
1406 ------------------------------------------------------------------------------}
1407function TCarbonWindow.GetWindowRelativePos(winX, winY: Integer): TPoint;
1408var
1409  R,G: MacOSAll.Rect;
1410begin
1411  if Assigned(fWindowRef) then
1412  begin
1413    OSError(GetWindowBounds(fWindowRef, kWindowStructureRgn, G{%H-}),
1414      Self, 'GetMousePos', SGetWindowBounds);
1415    OSError(GetWindowBounds(fWindowRef, kWindowContentRgn, R{%H-}),
1416      Self, 'GetMousePos', SGetWindowBounds);
1417    Result.X := winX - (R.left-G.Left);
1418    Result.Y := winY - (R.Top-G.Top);
1419  end
1420  else
1421    Result := inherited GetWindowRelativePos(winX, winY);
1422end;
1423
1424{------------------------------------------------------------------------------
1425  Method:  TCarbonWindow.GetTopParentWindow
1426  Returns: Retrieves the window reference
1427 ------------------------------------------------------------------------------}
1428function TCarbonWindow.GetTopParentWindow: WindowRef;
1429begin
1430  if Assigned(fWindowRef) then
1431    Result := fWindowRef
1432  else
1433    Result := inherited GetTopParentWindow;
1434end;
1435
1436{------------------------------------------------------------------------------
1437  Method:  TCarbonWindow.GetClientRect
1438  Params:  ARect - Record for client area coordinates
1439  Returns: If the function succeeds
1440
1441  Returns the window client rectangle relative to the window frame origin
1442 ------------------------------------------------------------------------------}
1443function TCarbonWindow.GetClientRect(var ARect: TRect): Boolean;
1444var
1445  AWndRect, AClientRect: MacOSAll.Rect;
1446const
1447  SName = 'GetClientRect';
1448begin
1449  if Assigned(fWindowRef) then begin
1450    Result := False;
1451    if OSError(
1452      GetWindowBounds(fWindowRef, kWindowStructureRgn, AWndRect{%H-}), Self,
1453      SName, SGetWindowBounds, 'kWindowStructureRgn') then Exit;
1454    if OSError(
1455      GetWindowBounds(fWindowRef, kWindowContentRgn, AClientRect{%H-}), Self,
1456      SName, SGetWindowBounds, 'kWindowContentRgn') then Exit;
1457
1458    ARect.Left := AClientRect.Left - AWndRect.Left;
1459    ARect.Top := AClientRect.Top - AWndRect.Top;
1460    ARect.Right := AClientRect.Right - AWndRect.Left;
1461    ARect.Bottom := AClientRect.Bottom - AWndRect.Top;
1462
1463    Result := True;
1464  end else
1465    Result := inherited GetClientRect(ARect);
1466end;
1467
1468{------------------------------------------------------------------------------
1469  Method:  TCarbonWindow.Invalidate
1470  Params:  Rect - Pointer to rect (optional)
1471
1472  Invalidates the specified rect or entire area of window content
1473 ------------------------------------------------------------------------------}
1474procedure TCarbonWindow.Invalidate(Rect: PRect);
1475var
1476  R: TRect;
1477begin
1478  if Rect = nil then
1479    OSError(HiViewSetNeedsDisplay(HIViewRef(Content), True), Self, SInvalidate,
1480      SViewNeedsDisplay)
1481  else
1482  begin
1483    R := Rect^;
1484    InflateRect(R, 1, 1);
1485    OSError(
1486      HiViewSetNeedsDisplayInRect(HIViewRef(Content), RectToCGRect(R), True),
1487      Self, SInvalidate, SViewNeedsDisplayRect);
1488  end;
1489end;
1490
1491{------------------------------------------------------------------------------
1492  Method:  TCarbonWindow.IsEnabled
1493  Returns: If window is enabled
1494 ------------------------------------------------------------------------------}
1495function TCarbonWindow.IsEnabled: Boolean;
1496begin
1497  Result := IsControlEnabled(Content);
1498end;
1499
1500{------------------------------------------------------------------------------
1501  Method:  TCarbonWindow.IsVisible
1502  Returns: If window is visible
1503 ------------------------------------------------------------------------------}
1504function TCarbonWindow.IsVisible: Boolean;
1505begin
1506  if Assigned(fWindowRef) then
1507    Result := MacOSAll.IsWindowVisible(fWindowRef)
1508  else
1509    Result := inherited IsVisible;
1510
1511end;
1512
1513{------------------------------------------------------------------------------
1514  Method:  TCarbonWindow.Enable
1515  Params:  AEnable - if enable
1516  Returns: If window is enabled
1517
1518  Changes window enabled
1519 ------------------------------------------------------------------------------}
1520function TCarbonWindow.Enable(AEnable: Boolean): boolean;
1521begin
1522  if Assigned(fWindowRef) then begin
1523    Result := not MacOSAll.IsControlEnabled(Content);
1524
1525    // enable/disable window content
1526    // add/remove standard handler
1527
1528    if AEnable then
1529    begin
1530      OSError(MacOSAll.EnableControl(Content), Self, SEnable, SEnableControl);
1531      OSError(
1532        ChangeWindowAttributes(fWindowRef,kWindowStandardHandlerAttribute,
1533          kWindowNoAttributes), Self, SEnable, SChangeWindowAttrs);
1534    end
1535    else
1536    begin
1537      OSError(MacOSAll.DisableControl(Content), Self, SEnable, SDisableControl);
1538      OSError(
1539        ChangeWindowAttributes(fWindowRef, kWindowNoAttributes,
1540          kWindowStandardHandlerAttribute), Self, SEnable, SChangeWindowAttrs);
1541    end;
1542  end else
1543    Result := inherited Enable(AEnable)
1544end;
1545
1546{------------------------------------------------------------------------------
1547  Method:  TCarbonWindow.GetBounds
1548  Params:  ARect - Record for window coordinates
1549  Returns: If function succeeds
1550
1551  Returns the window bounding rectangle relative to the client origin of its
1552  parent
1553  Note: only the pos of rectangle is exact, its size is size of client area
1554 ------------------------------------------------------------------------------}
1555function TCarbonWindow.GetBounds(var ARect: TRect): Boolean;
1556var
1557  AWndRect, AClientRect: MacOSAll.Rect;
1558const
1559  SName = 'GetBounds';
1560begin
1561  if Assigned(fWindowRef) then begin
1562    Result := False;
1563
1564    if OSError(
1565      MacOSAll.GetWindowBounds(fWindowRef, kWindowStructureRgn, AWndRect{%H-}),
1566      Self, SName, SGetWindowBounds, 'kWindowStructureRgn') then Exit;
1567    if OSError(
1568      MacOSAll.GetWindowBounds(fWindowRef, kWindowContentRgn, AClientRect{%H-}),
1569      Self, SName, SGetWindowBounds, 'kWindowContentRgn') then Exit;
1570
1571    ARect.Left := AWndRect.Left;
1572    ARect.Top := AWndRect.Top;
1573    ARect.Right := ARect.Left + (AClientRect.Right - AClientRect.Left);
1574    ARect.Bottom := ARect.Top + (AClientRect.Bottom - AClientRect.Top);
1575
1576    Result := True;
1577  end else
1578    Result := inherited GetBounds(ARect);
1579end;
1580
1581{------------------------------------------------------------------------------
1582  Method:  TCarbonWindow.GetScreenBounds
1583  Params:  ARect - Record for window coordinates
1584  Returns: If function succeeds
1585
1586  Returns the window bounding rectangle relative to the screen
1587  Note: only the pos of rectangle is exact, its size is size of client area
1588 ------------------------------------------------------------------------------}
1589function TCarbonWindow.GetScreenBounds(var ARect: TRect): Boolean;
1590begin
1591  if Assigned(FWindowRef) then
1592    Result := GetBounds(ARect)
1593  else
1594    Result := inherited GetScreenBounds(ARect);
1595end;
1596
1597{------------------------------------------------------------------------------
1598  Method:  TCarbonWindow.SetBounds
1599  Params:  ARect - Record for window coordinates
1600  Returns: If function succeeds
1601
1602  Sets the window content bounding rectangle relative to the window frame origin
1603 ------------------------------------------------------------------------------}
1604function TCarbonWindow.SetBounds(const ARect: TRect): Boolean;
1605const
1606  SName = 'SetBounds';
1607begin
1608  if Assigned(fWindowRef) then begin //
1609    Result := False;
1610    BeginUpdate(fWindowRef);
1611    Resizing := True;
1612    try
1613      // set window width, height
1614      if OSError(MacOSAll.SetWindowBounds(fWindowRef, kWindowContentRgn,
1615        GetCarbonRect(ARect)), Self, SName, 'SetWindowBounds') then Exit;
1616      // set window left, top
1617      if OSError(MoveWindowStructure(fWindowRef, ARect.Left, ARect.Top),
1618        Self, SName, 'MoveWindowStructure') then Exit;
1619    finally
1620      Resizing := False;
1621      EndUpdate(fWindowRef);
1622    end;
1623    Result := True;
1624  end else
1625    Result := inherited SetBounds(ARect);
1626end;
1627
1628{------------------------------------------------------------------------------
1629  Method:  TCarbonWindow.SetFocus
1630
1631  Sets the focus to window
1632 ------------------------------------------------------------------------------}
1633procedure TCarbonWindow.SetFocus;
1634begin
1635  if Assigned(fWindowRef) then
1636    OSError(
1637      SetUserFocusWindow(fWindowRef), Self, SSetFocus, SSetUserFocusWindow)
1638  else
1639    inherited;
1640end;
1641
1642{------------------------------------------------------------------------------
1643  Method:  TCarbonWindow.SetColor
1644  Params:  AColor - New color
1645
1646  Sets the color of window content
1647 ------------------------------------------------------------------------------}
1648procedure TCarbonWindow.SetColor(const AColor: TColor);
1649var
1650  Color: TColor;
1651begin
1652  if Assigned(fWindowRef) then
1653  begin
1654    Color := AColor;
1655    if Color = clDefault then
1656      Color := LCLObject.GetDefaultColor(dctBrush);
1657    OSError(SetWindowContentColor(fWindowRef, ColorToRGBColor(Color)),
1658      Self, SSetColor, 'SetWindowContentColor');
1659  end
1660  else
1661    inherited SetColor(AColor);
1662end;
1663
1664{------------------------------------------------------------------------------
1665  Method:  TCarbonWindow.SetFont
1666  Params:  AFont - New font
1667
1668  Sets the font of window
1669 ------------------------------------------------------------------------------}
1670procedure TCarbonWindow.SetFont(const AFont: TFont);
1671begin
1672  if Assigned(fWindowRef) then // not supported
1673  else
1674    inherited SetFont(AFont);
1675end;
1676
1677{------------------------------------------------------------------------------
1678  Method:  TCarbonWindow.SetZOrder
1679  Params:  AOrder     - Order
1680           ARefWidget - Reference widget
1681
1682  Sets the Z order of window
1683 ------------------------------------------------------------------------------}
1684procedure TCarbonWindow.SetZOrder(AOrder: HIViewZOrderOp;
1685  ARefWidget: TCarbonWidget);
1686begin
1687  if Assigned(fWindowRef) then // not supported
1688  else
1689    inherited SetZOrder(AOrder, ARefWidget);
1690end;
1691
1692{------------------------------------------------------------------------------
1693  Method:  TCarbonWindow.ShowHide
1694  Params:  AVisible - if show
1695
1696  Shows or hides window
1697 ------------------------------------------------------------------------------}
1698procedure TCarbonWindow.ShowHide(AVisible: Boolean);
1699begin
1700  //DebugLn('TCarbonWindow.ShowHide ' + DbgSName(LCLobject),' ', DbgS(AVisible));
1701  if Assigned(fWindowRef) then begin
1702    if AVisible then
1703    begin
1704      MacOSAll.ShowWindow(fWindowRef);
1705    end
1706    else
1707      MacOSAll.HideWindow(fWindowRef);
1708  end else
1709    inherited ShowHide(AVisible);
1710end;
1711
1712{------------------------------------------------------------------------------
1713  Method:  TCarbonWindow.GetText
1714  Params:  S - Text
1715  Returns: If the function succeeds
1716
1717  Gets the title of window
1718 ------------------------------------------------------------------------------}
1719function TCarbonWindow.GetText(var S: String): Boolean;
1720begin
1721  Result := False; // window title is static
1722end;
1723
1724{------------------------------------------------------------------------------
1725  Method:  TCarbonWindow.SetText
1726  Params:  S - New text
1727  Returns: If the function succeeds
1728
1729  Sets the title of window
1730 ------------------------------------------------------------------------------}
1731function TCarbonWindow.SetText(const S: String): Boolean;
1732var
1733  CFString: CFStringRef;
1734begin
1735  //todo: S must be stored, to restore the text when switched between Window and Control mode
1736
1737  if Assigned(fWindowRef) then begin
1738    Result := False;
1739    CreateCFString(S, CFString);
1740    try
1741      if OSError(SetWindowTitleWithCFString(fWindowRef, CFString), Self,
1742        SSetText, 'SetWindowTitleWithCFString') then Exit;
1743      Result := True;
1744    finally
1745      FreeCFString(CFString);
1746    end;
1747  end else
1748    Result := inherited SetText(S);
1749end;
1750
1751{------------------------------------------------------------------------------
1752  Method:  TCarbonWindow.Update
1753  Returns: If the function succeeds
1754
1755  Updates window content
1756 ------------------------------------------------------------------------------}
1757function TCarbonWindow.Update: Boolean;
1758begin
1759  Result := False;
1760  if OSError(HIViewRender(Widget), Self, 'Update', SViewRender) then Exit;
1761  Result := True;
1762end;
1763
1764{------------------------------------------------------------------------------
1765  Method:  TCarbonWindow.WidgetAtPos
1766  Params:  P
1767  Returns: Retrieves the embedded Carbon control at the specified pos
1768 ------------------------------------------------------------------------------}
1769function TCarbonWindow.WidgetAtPos(const P: TPoint): ControlRef;
1770begin
1771  Result := Content;
1772end;
1773
1774{------------------------------------------------------------------------------
1775  Method:  TCarbonWindow.Activate
1776  Returns: If the function suceeds
1777
1778  Activates Carbon window
1779 ------------------------------------------------------------------------------}
1780function TCarbonWindow.Activate: Boolean;
1781begin
1782  Result := False;
1783  if not Assigned(fWindowRef) then Exit;
1784
1785  if OSError(ActivateWindow(fWindowRef, True), Self, 'Activate',
1786    'ActivateWindow') then Exit;
1787
1788  Result := True;
1789end;
1790
1791{------------------------------------------------------------------------------
1792  Method:  TCarbonWindow.CloseModal
1793
1794  Closes modal Carbon window
1795 ------------------------------------------------------------------------------}
1796procedure TCarbonWindow.CloseModal;
1797begin
1798  if not Assigned(fWindowRef) then Exit; // not possible to show modal if not Window mode
1799
1800  //if ((LCLObject as TCustomForm).Menu <> nil) and ((LCLObject as TCustomForm).Menu.HandleAllocated) and
1801  //   (CarbonWidgetSet.MainMenu <>  (LCLObject as TCustomForm).Menu.Handle) then
1802  CarbonWidgetSet.SetMainMenuEnabled(fPrevMenuEnabled);
1803
1804  OSError(
1805    SetWindowModality(fWindowRef, kWindowModalityNone, nil),
1806    Self, 'CloseModal', SSetModality);
1807end;
1808
1809{------------------------------------------------------------------------------
1810  Method:  TCarbonWindow.ShowModal
1811
1812  Shows modal Carbon window
1813 ------------------------------------------------------------------------------}
1814procedure TCarbonWindow.ShowModal;
1815begin
1816  if not Assigned(fWindowRef) then Exit; // not possible to show modal if not Window mode
1817
1818  OSError(
1819    SetWindowModality(fWindowRef, kWindowModalityAppModal, nil),
1820    Self, 'ShowModal', SSetModality);
1821
1822  SelectWindow(fWindowRef);
1823
1824  fPrevMenuEnabled:=CarbonWidgetset.MenuEnabled;
1825
1826  if ((LCLObject as TCustomForm).Menu <> nil) and
1827     ((LCLObject as TCustomForm).Menu.HandleAllocated) and
1828     (CarbonWidgetSet.MainMenu = (LCLObject as TCustomForm).Menu.Handle) then
1829  begin
1830    CarbonWidgetSet.SetMainMenuEnabled(True)
1831  end
1832  else
1833    // Disable the main menu, so the modal window cannot be called again
1834    // if it's previously called by the menu shortcut
1835    // see bug #15913
1836    CarbonWidgetSet.SetMainMenuEnabled(False);
1837end;
1838
1839{------------------------------------------------------------------------------
1840  Method:  TCarbonWindow.IsIconic
1841
1842  Check if window is minimized
1843 ------------------------------------------------------------------------------}
1844function TCarbonWindow.IsIconic: Boolean;
1845begin
1846  if not Assigned(fWindowRef) then Exit(False);
1847  Result := IsWindowCollapsed(fWindowRef);
1848end;
1849
1850{------------------------------------------------------------------------------
1851  Method:  TCarbonWindow.IsZoomed
1852
1853  Check if window is maximized
1854 ------------------------------------------------------------------------------}
1855function TCarbonWindow.IsZoomed: Boolean;
1856begin
1857  if not Assigned(fWindowRef) then Exit(False);
1858  Result := IsWindowInStandardState(fWindowRef, nil, nil);
1859end;
1860
1861{------------------------------------------------------------------------------
1862  Method:  TCarbonWindow.SetForeground
1863  Returns: If the function succeeds
1864
1865  Brings the Carbon window to front and activates it
1866------------------------------------------------------------------------------}
1867function TCarbonWindow.SetForeground: Boolean;
1868begin
1869  Result := False;
1870  if not Assigned(fWindowRef) then Exit;
1871
1872  SelectWindow(fWindowRef); // activate and move window to front
1873  Result := True;
1874end;
1875
1876{------------------------------------------------------------------------------
1877  Method:  TCarbonWindow.Show
1878  Params:  AShow - (SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED)
1879  Returns: If the function succeeds
1880
1881  Shows the Carbon window normal, minimized or maximized
1882------------------------------------------------------------------------------}
1883function TCarbonWindow.Show(AShow: Integer): Boolean;
1884var
1885  P: MacOSAll.Point;
1886  Maximized: Boolean;
1887  FullScreen: Boolean;
1888  UIMode: SystemUIMode;
1889  UIOptions: SystemUIOptions;
1890const
1891  SName = 'Show';
1892  SCollapse = 'CollapseWindow';
1893  SZoomIdeal = 'ZoomWindowIdeal';
1894begin
1895  Result := False;
1896  if not Assigned(fWindowRef) then
1897    Exit;
1898  //DebugLn('TCarbonWindow.Show ' + DbgS(AShow));
1899
1900  case AShow of
1901  SW_SHOW, SW_HIDE:
1902  begin
1903    ShowHide(AShow = SW_SHOW);
1904    Result := True;
1905  end;
1906
1907  SW_SHOWNORMAL, SW_SHOWMAXIMIZED, SW_SHOWFULLSCREEN:
1908  begin
1909    if IsWindowCollapsed(fWindowRef) then
1910      if OSError(CollapseWindow(fWindowRef, False),
1911        Self, SName, SCollapse) then Exit;
1912
1913    // for checking if any change is necessary
1914    Maximized := IsWindowInStandardState(fWindowRef, nil, nil);
1915    GetSystemUIMode(@UIMode, @UIOptions);
1916    FullScreen := (UIMode = kuiModeAllHidden) and (UIOptions = kUIOptionAutoShowMenuBar);
1917
1918    if FullScreen then
1919    begin
1920      SetSystemUIMode(kuiModeNormal, 0);
1921      if OSError(ZoomWindowIdeal(fWindowRef, inZoomIn, P{%H-}),
1922        Self, SName, SZoomIdeal, 'inZoomIn') then Exit;
1923      exit(True);
1924    end;
1925
1926    if (AShow = SW_SHOWNORMAL) then
1927    begin
1928      if Maximized then
1929        if OSError(ZoomWindowIdeal(fWindowRef, inZoomIn, P),
1930          Self, SName, SZoomIdeal, 'inZoomIn') then Exit;
1931    end
1932    else
1933    begin
1934      if AShow = SW_SHOWFULLSCREEN then
1935        SetSystemUIMode(kuiModeAllHidden, kUIOptionAutoShowMenuBar);
1936
1937      if not Maximized or (AShow = SW_SHOWFULLSCREEN) then
1938      begin
1939        P.v := $3FFF;
1940        P.h := $3FFF;
1941        if OSError(ZoomWindowIdeal(fWindowRef, inZoomOut, P),
1942         Self, SName, SZoomIdeal, 'inZoomOut') then Exit;
1943      end;
1944    end;
1945    SetForeground;
1946  end;
1947  SW_MINIMIZE:
1948    begin
1949      if OSError(CollapseWindow(fWindowRef, True),
1950        Self, SName, SCollapse) then Exit;
1951    end;
1952  SW_RESTORE:
1953    begin
1954      if IsIconic then
1955        SetForeground
1956      else if IsZoomed then begin
1957        if OSError(ZoomWindowIdeal(fWindowRef, inZoomIn, P),
1958          Self, SName, SZoomIdeal, 'inZoomIn') then Exit;
1959        SetForeground;
1960      end;
1961    end;
1962  end;
1963
1964  Result := True;
1965end;
1966
1967{------------------------------------------------------------------------------
1968  Method:  TCarbonWSCustomForm.SetBorderIcons
1969  Params:  ABorderIcons - Border icons
1970
1971  Sets the border icons of Carbon window
1972 ------------------------------------------------------------------------------}
1973procedure TCarbonWindow.SetBorderIcons(ABorderIcons: TBorderIcons);
1974var
1975  AttrsSet, AttrsRemove: WindowAttributes;
1976begin
1977  if not Assigned(fWindowRef) then Exit;
1978
1979  if csDesigning in LCLObject.ComponentState then Exit;
1980  BeginUpdate(fWindowRef);
1981  try
1982    AttrsSet := GetBorderWindowAttrs((LCLObject as TCustomForm).BorderStyle,
1983      ABorderIcons);
1984    AttrsRemove := (kWindowNoTitleBarAttribute or kWindowCloseBoxAttribute or
1985      kWindowCollapseBoxAttribute or kWindowFullZoomAttribute or
1986      kWindowResizableAttribute) and (not AttrsSet);
1987
1988    if OSError(
1989      ChangeWindowAttributes(fWindowRef, AttrsSet, AttrsRemove), Self,
1990        'SetBorderIcons', SChangeWindowAttrs) then Exit;
1991  finally
1992    EndUpdate(fWindowRef);
1993  end;
1994end;
1995
1996{------------------------------------------------------------------------------
1997  Method:  TCarbonWSCustomForm.SetFormBorderStyle
1998  Params:  AFormBorderStyle - Form border style
1999
2000  Sets the form border style of Carbon window
2001 ------------------------------------------------------------------------------}
2002procedure TCarbonWindow.SetFormBorderStyle(AFormBorderStyle: TFormBorderStyle);
2003var
2004  AttrsSet, AttrsRemove: WindowAttributes;
2005begin
2006
2007  if (csDesigning in LCLObject.ComponentState) or not Assigned(fWindowRef) then Exit;
2008  BeginUpdate(fWindowRef);
2009  try
2010    AttrsSet := GetBorderWindowAttrs(AFormBorderStyle,
2011      (LCLObject as TCustomForm).BorderIcons);
2012    AttrsRemove := (kWindowNoTitleBarAttribute or kWindowCloseBoxAttribute or
2013      kWindowCollapseBoxAttribute or kWindowFullZoomAttribute or
2014      kWindowResizableAttribute) and (not AttrsSet);
2015
2016    if OSError(
2017      ChangeWindowAttributes(fWindowRef, AttrsSet, AttrsRemove), Self,
2018        'SetFormBorderStyle', SChangeWindowAttrs) then Exit;
2019  finally
2020    EndUpdate(fWindowRef);
2021  end;
2022end;
2023