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 // "è" 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