From 30d1e0adcc50b54de51f7156b84d188f3498d562 Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 29 Apr 2008 07:06:44 +0000 Subject: [PATCH] set application hint when user selects menu items: - TMenuItem.IntfDoSelect - win32, qt, gtk2 implementation git-svn-id: trunk@15002 - --- lcl/include/menuitem.inc | 7 ++++++- lcl/interfaces/gtk2/gtk2wsmenus.pp | 29 +++++++++++++++++++++++--- lcl/interfaces/qt/qtwidgets.pas | 17 +++++++++++++++ lcl/interfaces/win32/win32callback.inc | 9 ++++++++ lcl/menus.pp | 1 + 5 files changed, 59 insertions(+), 4 deletions(-) diff --git a/lcl/include/menuitem.inc b/lcl/include/menuitem.inc index e07f5442a3..effc492df0 100644 --- a/lcl/include/menuitem.inc +++ b/lcl/include/menuitem.inc @@ -263,6 +263,11 @@ begin DesignerMenuItemClick(Self); end; +procedure TMenuItem.IntfDoSelect; +begin + Application.Hint := GetLongHint(Hint); +end; + {------------------------------------------------------------------------------ Function: TMenuItem.GetChildren Params: Proc - proc to be called for each child @@ -274,7 +279,7 @@ end; procedure TMenuItem.GetChildren(Proc: TGetChildProc; Root: TComponent); var i : Integer; -Begin +begin if not assigned (FItems) then exit; for i := 0 to FItems.Count - 1 do diff --git a/lcl/interfaces/gtk2/gtk2wsmenus.pp b/lcl/interfaces/gtk2/gtk2wsmenus.pp index 77c35c1b92..b67777f45b 100644 --- a/lcl/interfaces/gtk2/gtk2wsmenus.pp +++ b/lcl/interfaces/gtk2/gtk2wsmenus.pp @@ -39,6 +39,7 @@ type TGtk2WSMenuItem = class(TWSMenuItem) private protected + class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); public class procedure AttachMenu(const AMenuItem: TMenuItem); override; class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; @@ -83,8 +84,32 @@ implementation {$I gtkdefines.inc} +function Gtk2MenuItemSelect(item: Pointer; AMenuItem: TMenuItem): GBoolean; cdecl; +begin + AMenuItem.IntfDoSelect; + Result := CallBackDefaultReturn; +end; + +function Gtk2MenuItemDeselect(item: Pointer; AMenuItem: TMenuItem): GBoolean; cdecl; +begin + Application.Hint := ''; + Result := CallBackDefaultReturn; +end; + { TGtk2WSMenuItem } +class procedure TGtk2WSMenuItem.SetCallbacks(const AGtkWidget: PGtkWidget; + const AWidgetInfo: PWidgetInfo); +begin + // connect activate signal (i.e. clicked) + g_signal_connect(PGTKObject(AGtkWidget), 'activate', + TGTKSignalFunc(@gtkactivateCB), AWidgetInfo^.LCLObject); + g_signal_connect(PGTKObject(AGtkWidget), 'select', + TGTKSignalFunc(@Gtk2MenuItemSelect), AWidgetInfo^.LCLObject); + g_signal_connect(PGTKObject(AGtkWidget), 'deselect', + TGTKSignalFunc(@Gtk2MenuItemDeselect), AWidgetInfo^.LCLObject); +end; + class procedure TGtk2WSMenuItem.AttachMenu(const AMenuItem: TMenuItem); var //AccelKey: Integer; @@ -197,9 +222,7 @@ begin // create the hbox containing the label and the icon UpdateInnerMenuItem(AMenuItem, Widget); - // connect activate signal (i.e. clicked) - g_signal_connect(PGTKObject(Widget), 'activate', - TGTKSignalFunc(@gtkactivateCB), AMenuItem); + SetCallbacks(Widget, WidgetInfo); gtk_widget_show(Widget); {$IFDEF DebugLCLComponents} diff --git a/lcl/interfaces/qt/qtwidgets.pas b/lcl/interfaces/qt/qtwidgets.pas index 689b453eb5..06c7af4446 100644 --- a/lcl/interfaces/qt/qtwidgets.pas +++ b/lcl/interfaces/qt/qtwidgets.pas @@ -922,6 +922,7 @@ type private FIcon: QIconH; FTriggeredHook: QAction_hookH; + FHoveredHook: QAction_hookH; FAboutToHideHook: QMenu_hookH; FActionHandle: QActionH; FMenuItem: TMenuItem; @@ -936,6 +937,7 @@ type procedure AttachEvents; override; procedure DetachEvents; override; + procedure SlotHovered; cdecl; procedure SlotAboutToHide; cdecl; procedure SlotDestroy; cdecl; procedure SlotTriggered(checked: Boolean = False); cdecl; @@ -6587,6 +6589,7 @@ var Method: TMethod; begin FTriggeredHook := QAction_hook_create(ActionHandle); + FHoveredHook := QAction_hook_create(ActionHandle); FAboutToHideHook := QMenu_hook_create(Widget); FEventHook := QObject_hook_create(Widget); @@ -6594,6 +6597,9 @@ begin QAction_hook_hook_triggered(FTriggeredHook, Method); TEventFilterMethod(Method) := @EventFilter; + QAction_hovered_Event(Method) := @SlotHovered; + QAction_hook_hook_hovered(FHoveredHook, Method); + QMenu_aboutToHide_Event(Method) := @SlotAboutToHide; QMenu_hook_hook_aboutToHide(FAboutToHideHook, Method); @@ -6609,6 +6615,12 @@ begin FTriggeredHook := nil; end; + if FHoveredHook <> nil then + begin + QAction_hook_destroy(FHoveredHook); + FHoveredHook := nil; + end; + if FAboutToHideHook <> nil then begin QMenu_hook_destroy(FAboutToHideHook); @@ -6618,6 +6630,11 @@ begin inherited DetachEvents; end; +procedure TQtMenu.SlotHovered; cdecl; +begin + FMenuItem.IntfDoSelect; +end; + procedure TQtMenu.SlotAboutToHide; cdecl; begin if FMenuItem.Menu is TPopupMenu then diff --git a/lcl/interfaces/win32/win32callback.inc b/lcl/interfaces/win32/win32callback.inc index 5ab3065f64..b3212ca0be 100644 --- a/lcl/interfaces/win32/win32callback.inc +++ b/lcl/interfaces/win32/win32callback.inc @@ -1285,6 +1285,15 @@ begin end; end; + WM_MENUSELECT: + begin + TargetObject := GetMenuItemObject; + if TargetObject is TMenuItem then + TMenuItem(TargetObject).IntfDoSelect + else + Application.Hint := ''; + end; + WM_COMMAND: begin if LParam=0 then diff --git a/lcl/menus.pp b/lcl/menus.pp index 8051477555..4b187068dc 100644 --- a/lcl/menus.pp +++ b/lcl/menus.pp @@ -200,6 +200,7 @@ type function HasIcon: boolean; virtual; function HasParent: Boolean; override; procedure InitiateAction; virtual; + procedure IntfDoSelect; virtual; function IndexOf(Item: TMenuItem): Integer; function IndexOfCaption(const ACaption: string): Integer; virtual; function VisibleIndexOf(Item: TMenuItem): Integer;