1{ $Id$} 2{ 3 ***************************************************************************** 4 * Gtk2WSMenus.pp * 5 * -------------- * 6 * * 7 * * 8 ***************************************************************************** 9 10 ***************************************************************************** 11 This file is part of the Lazarus Component Library (LCL) 12 13 See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 for details about the license. 15 ***************************************************************************** 16} 17unit Gtk2WSMenus; 18 19{$mode objfpc}{$H+} 20 21interface 22 23uses 24 // RTL 25 Classes, Types, glib2, gdk2, gtk2, 26 // LazUtils 27 LazTracer, 28 // LCL 29 Gtk2Int, Gtk2Proc, Gtk2Globals, Gtk2Def, Gtk2Extra, 30 LCLType, LCLIntf, InterfaceBase, WSMenus, LMessages, Graphics, Menus, Forms; 31 32type 33 34 { TGtk2WSMenuItem } 35 36 TGtk2WSMenuItem = class(TWSMenuItem) 37 protected 38 class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); 39 published 40 class procedure AttachMenu(const AMenuItem: TMenuItem); override; 41 class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; 42 class procedure DestroyHandle(const AMenuItem: TMenuItem); override; 43 class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override; 44 class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override; 45 class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override; 46 class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override; 47 class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override; 48 class function SetRadioItem(const AMenuItem: TMenuItem; const {%H-}RadioItem: boolean): boolean; override; 49 class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override; 50 class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const {%H-}AIcon: TBitmap); override; 51 end; 52 53 { TGtk2WSMenu } 54 55 TGtk2WSMenu = class(TWSMenu) 56 published 57 class function CreateHandle(const AMenu: TMenu): HMENU; override; 58 class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, {%H-}UseRightToLeftReading : Boolean); override; 59 end; 60 61 { TGtk2WSMainMenu } 62 63 TGtk2WSMainMenu = class(TWSMainMenu) 64 published 65 end; 66 67 { TGtk2WSPopupMenu } 68 69 TGtk2WSPopupMenu = class(TWSPopupMenu) 70 protected 71 class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; 72 published 73 class function CreateHandle(const AMenu: TMenu): HMENU; override; 74 class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override; 75 end; 76 77 78implementation 79 80{$I gtk2defines.inc} 81 82var 83 MenuWidget: PGtkWidget = nil; 84 85function Gtk2MenuItemButtonPress(widget: PGtkWidget; event: PGdkEventButton; 86 {%H-}user_data: gpointer): gboolean; cdecl; 87var 88 Parent: PGtkWidget; 89 WidgetInfo: PWidgetInfo; 90begin 91 Result := False; 92 if (event^._type = GDK_BUTTON_PRESS) then 93 begin 94 Parent := gtk_widget_get_parent(Widget); 95 if (Parent <> nil) and GTK_IS_MENU_BAR(Parent) then 96 begin 97 if (gtk_menu_item_get_submenu(PGtkMenuItem(Widget)) = nil) then 98 begin 99 WidgetInfo := GetWidgetInfo(Widget); 100 if Assigned(TMenuItem(WidgetInfo^.LCLObject).OnClick) then 101 begin 102 gtk_menu_item_activate(PGtkMenuItem(Widget)); 103 // must be true because of issue #22616 104 Result := True; 105 end; 106 end; 107 end; 108 end; 109end; 110 111function Gtk2MenuItemActivate(widget: PGtkMenuItem; data: gPointer) : GBoolean; cdecl; 112var 113 Mess: TLMActivate; 114 LCLMenuItem: TMenuItem; 115begin 116 Result:= True; 117 {$IFDEF EventTrace} 118 EventTrace('activate', data); 119 {$ENDIF} 120 121 ResetDefaultIMContext; 122 123 if LockOnChange(PgtkObject(Widget),0) > 0 then Exit; 124 125 LCLMenuItem := TMenuItem(Data); 126 127 // the gtk fires activate for radio buttons when unchecking them 128 // the LCL expects only uncheck 129 if LCLMenuItem.RadioItem 130 and GtkWidgetIsA(PGtkWidget(Widget), GTK_TYPE_CHECK_MENU_ITEM) 131 and (not gtk_check_menu_item_get_active(PGTKCheckMenuItem(Widget))) then Exit; 132 133 FillChar(Mess{%H-}, SizeOf(Mess), #0); 134 Mess.Msg := LM_ACTIVATE; 135 Mess.Active := WA_ACTIVE; 136 Mess.Minimized := False; 137 Mess.ActiveWindow := 0; 138 Mess.Result := 0; 139 DeliverMessage(Data, Mess); 140 141 Result := CallBackDefaultReturn; 142end; 143 144function Gtk2MenuItemToggled(AMenuItem: PGTKCheckMenuItem; 145 AData: gPointer): GBoolean; cdecl; 146var 147 LCLMenuItem: TMenuItem; 148 Mess: TLMessage; 149 b: Boolean; 150 w: PGtkWidget; 151 WidgetInfo: PWidgetInfo; 152begin 153 Result := CallBackDefaultReturn; 154 {$IFDEF EventTrace} 155 EventTrace('toggled', AData); 156 {$ENDIF} 157 if LockOnChange(PgtkObject(AMenuItem),0) > 0 then Exit; 158 159 LCLMenuItem := TMenuItem(AData); 160 161 if (csDesigning in LCLMenuItem.ComponentState) then 162 exit; 163 164 w := gtk_get_event_widget(gtk_get_current_event); 165 166 if not GTK_IS_RADIO_MENU_ITEM(w) then 167 exit; 168 169 b := gtk_check_menu_item_get_active(AMenuItem); 170 171 if not LCLMenuItem.Checked then 172 g_signal_stop_emission_by_name(AMenuItem, 'toggled') 173 else 174 g_signal_stop_emission_by_name(AMenuItem, 'activate'); 175 176 if b <> LCLMenuItem.Checked then 177 gtk_check_menu_item_set_active(AMenuItem, LCLMenuItem.Checked); 178 179 {we must trigger OnClick() somehow, since we stopped signals} 180 if b and (w <> nil) and (w <> PGtkWidget(AMenuItem)) then 181 begin 182 WidgetInfo := GetWidgetInfo(w); 183 FillChar(Mess{%H-},SizeOf(Mess),#0); 184 Mess.Msg := LM_ACTIVATE; 185 WidgetInfo^.LCLObject.Dispatch(Mess); 186 end; 187end; 188 189function Gtk2MenuItemSelect({%H-}item: PGtkMenuItem; AMenuItem: gPointer): GBoolean; cdecl; 190begin 191 TMenuItem(AMenuItem).IntfDoSelect; 192 Result := CallBackDefaultReturn; 193end; 194 195procedure Gtk2MenuItemToggleSizeRequest(AMenuItem: PGtkMenuItem; requisition: Pgint; LCLItem: TMenuItem); cdecl; 196var 197 spacing: guint; 198 IconWidth: Integer; 199 DC: HDC; 200begin 201 if LCLItem.HasIcon then 202 begin 203 DC := Widgetset.GetDC(HWND({%H-}PtrUInt(AMenuItem))); 204 IconWidth := LCLItem.GetIconSize(DC).X; 205 WidgetSet.ReleaseDC(HWND({%H-}PtrUInt(AMenuItem)), DC); 206 if IconWidth > 0 then 207 begin 208 gtk_widget_style_get(PGtkWidget(AMenuItem), 'toggle-spacing', [@spacing, nil]); 209 requisition^ := IconWidth + spacing; 210 end 211 else 212 requisition^ := 0; 213 end 214 else 215 GTK_MENU_ITEM_GET_CLASS(AMenuItem)^.toggle_size_request(AMenuItem, requisition); 216end; 217 218procedure Gtk2MenuItemSizeRequest(AMenuItem: PGtkMenuItem; requisition: PGtkRequisition; LCLItem: TMenuItem); cdecl; 219var 220 IconHeight: Integer; 221 DC: HDC; 222begin 223 GTK_WIDGET_GET_CLASS(AMenuItem)^.size_request(PGtkWidget(AMenuItem), requisition); 224 DC := Widgetset.GetDC(HWND({%H-}PtrUInt(AMenuItem))); 225 IconHeight := LCLItem.GetIconSize(DC).Y; 226 Widgetset.ReleaseDC(HWND({%H-}PtrUInt(AMenuItem)), DC); 227 if requisition^.height < IconHeight then 228 requisition^.height := IconHeight; 229end; 230 231function Gtk2MenuItemDeselect({%H-}item: Pointer; {%H-}AMenuItem: TMenuItem): GBoolean; cdecl; 232begin 233 Application.Hint := ''; 234 Result := CallBackDefaultReturn; 235end; 236 237{ TGtk2WSMenuItem } 238 239class procedure TGtk2WSMenuItem.SetCallbacks(const AGtkWidget: PGtkWidget; 240 const AWidgetInfo: PWidgetInfo); 241begin 242 // connect activate signal (i.e. clicked) 243 {button-press-event is needed by root menu items which have not 244 submenu, but OnClick() is assigned - fix for #15986 } 245 g_signal_connect_after(PGTKObject(AGtkWidget), 'button-press-event', 246 TGTKSignalFunc(@Gtk2MenuItemButtonPress), AWidgetInfo^.LCLObject); 247 g_signal_connect(PGTKObject(AGtkWidget), 'activate', 248 TGTKSignalFunc(@Gtk2MenuItemActivate), AWidgetInfo^.LCLObject); 249 g_signal_connect(PGTKObject(AGtkWidget), 'select', 250 TGTKSignalFunc(@Gtk2MenuItemSelect), AWidgetInfo^.LCLObject); 251 g_signal_connect(PGTKObject(AGtkWidget), 'deselect', 252 TGTKSignalFunc(@Gtk2MenuItemDeselect), AWidgetInfo^.LCLObject); 253 g_signal_connect(PGTKObject(AGtkWidget), 'toggle-size-request', 254 TGTKSignalFunc(@Gtk2MenuItemToggleSizeRequest), AWidgetInfo^.LCLObject); 255 g_signal_connect(PGTKObject(AGtkWidget), 'size-request', 256 TGTKSignalFunc(@Gtk2MenuItemSizeRequest), AWidgetInfo^.LCLObject); 257end; 258 259class procedure TGtk2WSMenuItem.AttachMenu(const AMenuItem: TMenuItem); 260var 261 MenuItem, ParentMenuWidget, ContainerMenu: PGtkWidget; 262begin 263 with AMenuItem do 264 begin 265 MenuItem := {%H-}PGtkWidget(Handle); 266 if MenuItem=nil then 267 RaiseGDBException('TGtkWidgetSet.AttachMenu Handle=0'); 268 ParentMenuWidget := {%H-}PGtkWidget(Parent.Handle); 269 if ParentMenuWidget=nil then 270 RaiseGDBException('TGtkWidgetSet.AttachMenu ParentMenuWidget=nil'); 271 272 if GTK_IS_MENU_BAR(ParentMenuWidget) then 273 begin 274 // mainmenu (= a menu bar) 275 ContainerMenu := ParentMenuWidget; 276 gtk_menu_bar_insert(ParentMenuWidget, MenuItem, AMenuItem.MenuVisibleIndex); 277 end 278 else 279 begin 280 // if it is a menu 281 if GTK_IS_MENU(ParentMenuWidget) then 282 ContainerMenu := ParentMenuWidget 283 else // menu item 284 ContainerMenu := PGtkWidget(g_object_get_data(PGObject(ParentMenuWidget), 285 'ContainerMenu')); // find the menu container 286 287 if ContainerMenu = nil then 288 begin 289 if (GetParentMenu is TPopupMenu) and (Parent.Parent=nil) then 290 begin 291 ContainerMenu := {%H-}PGtkWidget(GetParentMenu.Handle); 292 g_object_set_data(PGObject(ContainerMenu), 'ContainerMenu', 293 ContainerMenu); 294 end else 295 begin 296 ContainerMenu := gtk_menu_new; 297 g_object_set_data(PGObject(ParentMenuWidget), 'ContainerMenu', 298 ContainerMenu); 299 gtk_menu_item_set_submenu(PGTKMenuItem(ParentMenuWidget), ContainerMenu); 300 end; 301 end; 302 gtk_menu_insert(ContainerMenu, MenuItem, AMenuItem.MenuVisibleIndex); 303 end; 304 305 if GtkWidgetIsA(MenuItem, GTK_TYPE_RADIO_MENU_ITEM) then 306 TGtk2WidgetSet(WidgetSet).RegroupMenuItem(HMENU({%H-}PtrUInt(MenuItem)), GroupIndex); 307 end; 308end; 309 310class function TGtk2WSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU; 311var 312 Widget: PGtkWidget; 313 WidgetInfo: PWidgetInfo; 314begin 315 // create the menuitem widget (normal, check or radio) 316 if AMenuItem.Caption = cLineCaption then // create separator 317 Widget := gtk_separator_menu_item_new 318 else 319 if AMenuItem.RadioItem and not AMenuItem.HasIcon then 320 Widget := gtk_radio_menu_item_new(nil) 321 else 322 if AMenuItem.IsCheckItem or AMenuItem.HasIcon then 323 Widget := gtk_check_menu_item_new 324 else 325 Widget := gtk_menu_item_new; 326 327 WidgetInfo := CreateWidgetInfo(Widget); 328 WidgetInfo^.LCLObject := AMenuItem; 329 330 if GtkWidgetIsA(Widget, GTK_TYPE_CHECK_MENU_ITEM) then 331 begin 332 // check or radio 333 // set 'ShowAlwaysCheckable' 334 gtk_check_menu_item_set_show_toggle(PGtkCheckMenuItem(Widget), 335 AMenuItem.ShowAlwaysCheckable); 336 // set 'Checked' 337 gtk_check_menu_item_set_active(PGtkCheckMenuItem(Widget), 338 AMenuItem.Checked); 339 340 g_signal_connect(PGTKObject(Widget), 'toggled', 341 TGTKSignalFunc(@Gtk2MenuItemToggled), Pointer(AMenuItem)); 342 end; 343 344 // set attributes (enabled and rightjustify) 345 gtk_widget_set_sensitive(Widget, AMenuItem.Enabled); 346 if AMenuItem.RightJustify then 347 gtk_menu_item_right_justify(PGtkMenuItem(Widget)); 348 349 // create the hbox containing the label and the icon 350 UpdateInnerMenuItem(AMenuItem, Widget); 351 352 SetCallbacks(Widget, WidgetInfo); 353 354 gtk_widget_show(Widget); 355 {$IFDEF DebugLCLComponents} 356 DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenuItem)); 357 {$ENDIF} 358 Result := HMENU({%H-}PtrUInt(Widget)); 359end; 360 361class procedure TGtk2WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem); 362begin 363 { TODO: cleanup } 364 TGtk2WidgetSet(WidgetSet).DestroyLCLComponent(AMenuItem); 365end; 366 367class procedure TGtk2WSMenuItem.SetCaption(const AMenuItem: TMenuItem; 368 const ACaption: string); 369var 370 MenuItemWidget: PGtkWidget; 371begin 372 if not WSCheckMenuItem(AMenuItem, 'SetCaption') then 373 Exit; 374 if gtk_is_separator_menu_item({%H-}PGTKWidget(AMenuItem.Handle)) Or (ACaption = cLineCaption) then 375 AMenuItem.RecreateHandle 376 else 377 begin 378 MenuItemWidget:={%H-}PGtkWidget(AMenuItem.Handle); 379 UpdateInnerMenuItem(AMenuItem,MenuItemWidget); 380 gtk_widget_set_sensitive({%H-}PGtkWidget(AMenuItem.Handle), AMenuItem.Enabled); 381 end; 382end; 383 384class procedure TGtk2WSMenuItem.SetShortCut(const AMenuItem: TMenuItem; 385 const ShortCutK1, ShortCutK2: TShortCut); 386//var 387 //MenuWidget: PGtkMenuItem; 388 //accel_path: String; 389 //CurKey: Word; 390 //CurShift: TShiftState; 391begin 392 if not WSCheckMenuItem(AMenuItem, 'SetShortCut') then Exit; 393 394 // Temporary: At least it writes the names of the shortcuts 395 UpdateInnerMenuItem(AMenuItem, {%H-}PGTKWidget(AMenuItem.Handle), ShortCutK1, ShortCutK2); 396 397{ // Gets the inner widgets. They should already be created by now 398 MenuWidget := PGtkMenuItem(AMenuItem.Handle); 399 if (MenuWidget=nil) then Exit; 400 // Converts the shortcut to a gtk friendly format and sets it 401 ShortCutToKey(NewShortCut, CurKey, CurShift); 402 accel_path := 'LCLApp/Menu/' + GetAcceleratorString(CurKey, CurShift); 403 gtk_accel_map_add_entry(accel_path, CurKey, ShiftToGdkModifierType); 404 gtk_menu_item_set_accel_path(); } 405end; 406 407class procedure TGtk2WSMenuItem.SetVisible(const AMenuItem: TMenuItem; 408 const Visible: boolean); 409var 410 MenuItemWidget: PGtkWidget; 411begin 412 if not WSCheckMenuItem(AMenuItem, 'SetVisible') then 413 Exit; 414 MenuItemWidget := {%H-}PGtkWidget(AMenuItem.Handle); 415 if gtk_widget_visible(MenuItemWidget) = Visible then 416 Exit; 417 if Visible then 418 gtk_widget_show(MenuItemWidget) 419 else 420 gtk_widget_hide(MenuItemWidget); 421end; 422 423class function TGtk2WSMenuItem.SetCheck(const AMenuItem: TMenuItem; 424 const Checked: boolean): boolean; 425var 426 IsRadio: Boolean; 427 Group: PGSList; 428 Item: Pointer; 429begin 430 Result:=false; 431 if not WSCheckMenuItem(AMenuItem, 'SetCheck') then 432 Exit; 433 Item := {%H-}Pointer(AMenuItem.Handle); 434 IsRadio := gtk_is_radio_menu_item(Item); 435 if IsRadio or gtk_is_check_menu_item(Item) 436 then begin 437 if IsRadio 438 then begin 439 Group := gtk_radio_menu_item_group(Item); 440 LockRadioGroupOnChange(Group, +1); 441 end 442 else LockOnChange(Item, +1); 443 gtk_check_menu_item_set_active(Item, Checked); 444 if IsRadio 445 then LockRadioGroupOnChange(Group, -1) 446 else LockOnChange(Item, -1); 447 Result := True; 448 end 449 else begin 450 AMenuItem.RecreateHandle; 451 Result := True; 452 end; 453end; 454 455class function TGtk2WSMenuItem.SetEnable(const AMenuItem: TMenuItem; 456 const Enabled: boolean): boolean; 457begin 458 Result := False; 459 if not WSCheckMenuItem(AMenuItem, 'SetEnable') then 460 Exit; 461 gtk_widget_set_sensitive({%H-}PGtkWidget(AMenuItem.Handle), Enabled); 462 Result := True; 463end; 464 465class function TGtk2WSMenuItem.SetRadioItem(const AMenuItem: TMenuItem; 466 const RadioItem: boolean): boolean; 467begin 468 AMenuItem.RecreateHandle; 469 Result := True; 470end; 471 472class function TGtk2WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; 473 const Justified: boolean): boolean; 474var 475 MenuItemWidget: PGtkMenuItem; 476begin 477 Result := False; 478 if not WSCheckMenuItem(AMenuItem, 'SetRightJustify') then 479 Exit; 480 MenuItemWidget := {%H-}PGtkMenuItem(AMenuItem.Handle); 481 gtk_menu_item_set_right_justified(MenuItemWidget, Justified); 482 gtk_widget_queue_resize(GTK_WIDGET(MenuItemWidget)); 483 Result := True; 484end; 485 486class procedure TGtk2WSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem; 487 const HasIcon: Boolean; const AIcon: TBitmap); 488begin 489 if not WSCheckMenuItem(AMenuItem, 'UpdateMenuIcon') then 490 Exit; 491 // recreating menu handle without icon may lead to failures like 492 // main menu bar vanishing, see mantis issue #37607 493 if HasIcon then 494 AMenuItem.RecreateHandle; 495end; 496 497{ TGtk2WSMenu } 498 499class function TGtk2WSMenu.CreateHandle(const AMenu: TMenu): HMENU; 500var 501 Widget: PGtkWidget; 502 WidgetInfo: PWidgetInfo; 503 Box: Pointer; 504 ParentForm: TCustomForm; 505const 506 MenuDirection : array[Boolean] of Longint = ( 507 GTK_PACK_DIRECTION_LTR, 508 GTK_PACK_DIRECTION_RTL); 509begin 510 Widget := gtk_menu_bar_new(); 511 // get the VBox, the form has one child, a VBox 512 ParentForm := TCustomForm(AMenu.Parent); 513 if (ParentForm=nil) or (not (ParentForm is TCustomForm)) then 514 RaiseGDBException('MainMenu without form'); 515 if ParentForm.Menu <> AMenu then 516 RaiseGDBException('Form already has a MainMenu'); 517 if ParentForm.HandleAllocated then 518 begin 519 Box := {%H-}PGTKBin(ParentForm.Handle)^.Child; 520 gtk_box_pack_start(Box, Widget, False, False, 0); 521 end; 522 523 gtk_menu_bar_set_pack_direction(PGtkMenuBar(Widget), MenuDirection[AMenu.UseRightToLeftAlignment]); 524 gtk_widget_show(Widget); 525 526 {$IFDEF DebugLCLComponents} 527 DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenu)); 528 {$ENDIF} 529 Result := THandle({%H-}PtrUInt(Widget)); 530 WidgetInfo := CreateWidgetInfo(Widget); 531 WidgetInfo^.LCLObject := AMenu; 532 // no callbacks for main menu 533end; 534 535class procedure TGtk2WSMenu.SetBiDiMode(const AMenu : TMenu; 536 UseRightToLeftAlign, UseRightToLeftReading : Boolean); 537const 538 WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL); 539{$ifdef GTK_2_8} 540const 541 MenuDirection : array[Boolean] of Longint = ( 542 GTK_PACK_DIRECTION_LTR, 543 GTK_PACK_DIRECTION_RTL); 544{$endif} 545 procedure Switch(AMenuItem: TMenuItem; Flip: Boolean); 546 var 547 i: Integer; 548 begin 549 if Flip then 550 begin 551 if AMenuItem.HandleAllocated then begin 552 gtk_widget_set_direction({%H-}PGtkWidget(AMenuItem.Handle), WidgetDirection[UseRightToLeftAlign]); 553 UpdateInnerMenuItem(AMenuItem, {%H-}PGtkWidget(AMenuItem.Handle)); 554 end; 555 end; 556 for i := 0 to AMenuItem.Count -1 do 557 Switch(AMenuItem[i], True); 558 end; 559begin 560 {$ifdef GTK_2_8} 561 gtk_menu_bar_set_pack_direction({%H-}PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]); 562 gtk_menu_bar_set_child_pack_direction({%H-}PGtkMenuBar(AMenu.Handle), MenuDirection[UseRightToLeftAlign]); 563 {$endif} 564 //gtk_widget_set_direction(PGtkWidget(AMenu.Handle), WidgetDirection[UseRightToLeftAlign]); 565 Switch(AMenu.Items, False); 566end; 567 568{ TGtk2WSPopupMenu } 569 570procedure GtkWS_Popup(menu: PGtkMenu; X, Y: pgint; {%H-}push_in: pgboolean; 571 WidgetInfo: PWidgetInfo); cdecl; 572var 573 Requisition: TGtkRequisition; 574 Alignment: TPopupAlignment; 575 ScreenHeight: gint; 576begin 577 X^ := PPoint(WidgetInfo^.UserData)^.X; 578 Y^ := PPoint(WidgetInfo^.UserData)^.Y; 579 580 if WidgetInfo^.LCLObject is TPopupMenu then 581 begin 582 // make menu to fit the screen vertically 583 gtk_widget_size_request(PGtkWidget(menu), @Requisition); 584 ScreenHeight := gdk_screen_height(); 585 if Y^ + Requisition.height > ScreenHeight then 586 begin 587 Y^ := ScreenHeight - Requisition.height; 588 if Y^ < 0 then Y^ := 0; 589 end; 590 591 // get actual alignment 592 Alignment := TPopupMenu(WidgetInfo^.LCLObject).Alignment; 593 if TPopupMenu(WidgetInfo^.LCLObject).UseRightToLeftAlignment then 594 begin 595 if Alignment = paLeft then 596 Alignment := paRight 597 else 598 if Alignment = paRight then 599 Alignment := paLeft; 600 end; 601 602 case Alignment of 603 paCenter: X^ := X^ - Requisition.width div 2; 604 paRight: X^ := X^ - Requisition.width; 605 end; 606 end; 607end; 608 609function gtkWSPopupDelayedClose(Data: Pointer): gboolean; cdecl; 610var 611 PopupMenu: TPopupMenu absolute data; 612begin 613 Result := False; 614 if PopupMenu is TPopupMenu then 615 begin 616 PopupMenu.Close; 617 // Fix freezing some controls (eg SpeedButton) when close PopupMenu 618 LastMouse.Button := 0; 619 LastMouse.ClickCount := 0; 620 LastMouse.Down := False; 621 LastMouse.MousePos := Point(0, 0); 622 LastMouse.Time := 0; 623 LastMouse.WinControl := nil; 624 end; 625end; 626 627procedure gtkWSPopupMenuDeactivate(widget: PGtkWidget; data: gPointer); cdecl; 628begin 629 if widget = MenuWidget then 630 MenuWidget := nil; 631 if data <> nil then 632 g_idle_add(@gtkWSPopupDelayedClose, Pointer(PWidgetInfo(data)^.LCLObject)); 633end; 634 635 636class procedure TGtk2WSPopupMenu.SetCallbacks(const AGtkWidget: PGtkWidget; 637 const AWidgetInfo: PWidgetInfo); 638begin 639 g_signal_connect_after(PGtkObject(AGtkWidget), 'deactivate', 640 gtk_signal_func(@gtkWSPopupMenuDeactivate), AWidgetInfo); 641end; 642 643class function TGtk2WSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU; 644var 645 Widget: PGtkWidget; 646 WidgetInfo: PWidgetInfo; 647begin 648 Widget := gtk_menu_new; 649 Result := HMENU({%H-}PtrUInt(Widget)); 650 {$IFDEF DebugLCLComponents} 651 DebugGtkWidgets.MarkCreated(Widget, dbgsName(AMenu)); 652 {$ENDIF} 653 WidgetInfo := CreateWidgetInfo(Widget); 654 WidgetInfo^.LCLObject := AMenu; 655 SetCallbacks(Widget, WidgetInfo); 656end; 657 658class procedure TGtk2WSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, 659 Y: integer); 660var 661 APoint: TPoint; 662 AProc: Pointer; 663 WidgetInfo: PWidgetInfo; 664begin 665 if MenuWidget<>nil then //cannot popup when another popup menu is visible 666 Exit; 667 668 ReleaseMouseCapture; 669 APoint.X := X; 670 APoint.Y := Y; 671 AProc := @GtkWS_Popup; 672 673 MenuWidget := {%H-}PGtkWidget(APopupMenu.Handle); 674 WidgetInfo := GetWidgetInfo(MenuWidget); 675 WidgetInfo^.UserData := @APoint; 676 WidgetInfo^.DataOwner := False; 677 // MenuWidget can be either GtkMenu or GtkMenuItem submenu 678 if GTK_IS_MENU_ITEM(MenuWidget) then 679 MenuWidget := gtk_menu_item_get_submenu(PGtkMenuItem(MenuWidget)); 680 gtk_menu_popup(PGtkMenu(MenuWidget), nil, nil, TGtkMenuPositionFunc(AProc), 681 WidgetInfo, 0, gtk_get_current_event_time()); 682 repeat 683 try 684 WidgetSet.AppProcessMessages; // process all events 685 except 686 if Application.CaptureExceptions then 687 Application.HandleException(APopupMenu) 688 else 689 raise; 690 end; 691 if Application.Terminated or not Assigned(MenuWidget) then 692 break; 693 Application.Idle(true); 694 until False; 695end; 696 697end. 698