B4J=true Group=Default Group ModulesStructureVersion=1 Type=Class Version=5.9 @EndOfDesignText@ #Event: CustomAction(MC AS MenuCustomClass) #Event: Action(MI as MenuItemTextClass) #Event: SelectedChanged(MCB as MenuCheckBoxClass) #Event: MenuOpening(M as Menu) Sub Class_Globals Private fx As JFX Type MenuItemType(mType As String,Text As String) Type MenuSubMenuType(Title As String, SubMenu As List) Public Const MENUTYPE_MENU As String = "menu" Public Const MENUTYPE_CONTEXTMENU As String = "context" Private mMenuType As String = MENUTYPE_MENU Private mMenuTitle As String Private CM As ContextMenu Private MU As Menu Private mModule As Object Private mEventName As String Private CustomNodeList As List End Sub 'Initializes the object 'Default menuType is MENUTYPE_MENU Public Sub Initialize(Module As Object, EventName As String, MenuTitleText As String) mModule = Module mEventName = EventName mMenuTitle = MenuTitleText MU.Initialize(mMenuTitle,"MU") AddStyle(MU,Array As String("")) Dim MUJO As JavaObject = MU Dim O As Object = MUJO.CreateEventFromUI("javafx.event.EventHandler","MU",Null) MUJO.RunMethod("setOnShowing",Array(O)) End Sub 'Get / Set MenuType one of the constants: MENUTYPE_MENU or MENUTYPE_CONTEXTMENU Public Sub setMenuType(MenuType As String) mMenuType = MenuType If mMenuType = MENUTYPE_CONTEXTMENU Then If CM.IsInitialized = False Then CM.Initialize("CM") AddStyle(CM,Array As String("")) End If End If End Sub Public Sub getMenuType As String Return mMenuType End Sub 'Add text or Menuitems items to the menu, as an array, Pass a '-' to add a text seperator 'FM.AddItems(Array As String("Test","-","Test1")) Public Sub AddItems(Items As List,Clear As Boolean) If mMenuType = MENUTYPE_CONTEXTMENU Then If Clear Then CM.MenuItems.Clear If CustomNodeList.IsInitialized Then CustomNodeList.Clear End If BuildContextMenu (Items) End If If mMenuType = MENUTYPE_MENU Then If Clear Then MU.MenuItems.Clear BuildMenu(Items) End If End Sub Private Sub BuildMenu (Items As List) 'Populate the context menu For Each It As Object In Items If It Is MenuSubMenuType Then Dim SMT As MenuSubMenuType = It MU.MenuItems.Add(BuildSubMenu(SMT.Title,SMT.SubMenu)) Else IF It Is MenuCheckBoxClass Then Dim MCB As MenuCheckBoxClass = It MU.MenuItems.Add(MCB.AsObject) Else If It Is MenuItemTextClass Then Dim MIT As MenuItemTextClass = It MU.MenuItems.Add(MIT.AsObject) Else IF It Is MenuCustomClass Then Dim CIT As MenuCustomClass = It MU.MenuItems.Add(CIT.AsObject) Else MU.MenuItems.Add(It) End If Next End Sub Private Sub BuildContextMenu (Items As List) 'Populate the context menu For Each It As Object In Items If It Is MenuSubMenuType Then Dim SMT As MenuSubMenuType = It CM.MenuItems.Add(BuildSubMenu(SMT.Title,SMT.SubMenu)) Else IF It Is MenuCheckBoxClass Then Dim MCB As MenuCheckBoxClass = It CM.MenuItems.Add(MCB.AsObject) Else If It Is MenuItemTextClass Then Dim MIT As MenuItemTextClass = It CM.MenuItems.Add(MIT.AsObject) Else IF It Is MenuCustomClass Then Dim CIT As MenuCustomClass = It CM.MenuItems.Add(CIT.AsObject) Else CM.MenuItems.Add(It) End If Next End Sub 'Build and return a submenu Private Sub BuildSubMenu(Title As String,Items As List) As Menu Dim M As Menu M.Initialize(Title,"MI") 'Process the menu Items For Each It As Object In Items If It Is MenuSubMenuType Then Dim SMT As MenuSubMenuType = It M.MenuItems.Add(BuildSubMenu(SMT.Title,SMT.SubMenu)) Else IF It Is MenuCheckBoxClass Then Dim MCB As MenuCheckBoxClass = It M.MenuItems.Add(MCB.AsObject) AddStyle(MCB.AsJavaObject,Array As String("")) Else If It Is MenuItemTextClass Then Dim MIT As MenuItemTextClass = It M.MenuItems.Add(MIT.AsObject) AddStyle(MIT.AsJavaObject,Array As String("")) Else IF It Is MenuCustomClass Then Dim CIT As MenuCustomClass = It M.MenuItems.Add(CIT.AsObject) AddStyle(CIT.AsJavaObject,Array As String("")) End If Next 'Add a style to the SubMenu AddStyle(M,Array As String("")) Return M End Sub Private Sub AddStyle(Target As JavaObject,Styles() As String) Dim S() As String Dim MString As String If mMenuType = MENUTYPE_MENU Then MString = "mm-menu" Else MString = "mm-cmenu" End If Dim L As List = Target.RunMethodJO("getStyleClass",Null) If L.IndexOf(MString) = -1 Then Dim S(Styles.Length + 1) As String For i = 0 To Styles.Length -1 S(i+1) = Styles(i) Next S(0) = MString Else S = Styles End If Target.RunMethodJO("getStyleClass",Null).RunMethod("addAll",Array(S)) End Sub Public Sub getMenu As Object If mMenuType = MENUTYPE_CONTEXTMENU Then Return CM If mMenuType = MENUTYPE_MENU Then Return MU Return Null End Sub 'Menu item clicked, pass it back to the originating module Private Sub MI_Action Dim MI As MenuItemTextClass = Sender Dim EName As String = mEventName If MI.GetEventName <> "" Then EName = MI.GetEventName If SubExists(mModule,EName & "_Action") Then CallSub2(mModule,EName & "_Action",MI) End Sub 'Custom Menu item clicked, pass it back to the originating module Private Sub MC_Action Dim MC As MenuCustomClass = Sender Dim EName As String = mEventName If MC.GetEventName <> "" Then EName = MC.GetEventName If SubExists(mModule,EName & "_CustomAction") Then CallSub2(mModule,EName & "_CustomAction",MC) End Sub Private Sub MU_Event (MethodName As String, Args() As Object) Dim M As Menu = Sender If SubExists(mModule,mEventName & "_MenuOpening") Then CallSub2(mModule,mEventName & "_MenuOpening",M) End Sub Private Sub CB_SelectedChanged(MCB As MenuCheckBoxClass) Dim EName As String = mEventName If MCB.GetEventName <> "" Then EName = MCB.GetEventName If SubExists(mModule,EName &"_SelectedChanged") Then CallSub2(mModule,EName & "_SelectedChanged",MCB) End Sub Private Sub CB_Action(MCB As MenuCheckBoxClass) Dim EName As String = mEventName If MCB.GetEventName <> "" Then EName = MCB.GetEventName If SubExists(mModule,EName &"_Action") Then CallSub2(mModule,EName & "_Action",MCB) End Sub 'Create a simple menu List from a string array 'Use '-' for a separator. Pass the result to MM.AddItems Public Sub SimpleMenuList(Simple() As String) As List Dim L As List L.Initialize For Each S As String In Simple If S = "-" Then L.Add(MenuSeparator) Else L.Add(MenuText(S)) End If Next Return L End Sub 'Create a simple menu Array from a string array 'No Seperators. Pass the result to MM.AddItems 'Configure extras e.g. A(2).SetTag("Tag 2") Public Sub SimpleMenuArray(Simple() As String) As MenuItemTextClass() Dim A(Simple.length) As MenuItemTextClass For i = 0 To Simple.Length -1 A(i) = MenuText(Simple(i)) Next Return A End Sub 'Create a sub menu with title and content Public Sub MenuSubMenu(Title As String,SubMenu As List) As MenuSubMenuType Dim SM As MenuSubMenuType SM.Initialize SM.Title = Title SM.SubMenu = SubMenu ' AddStyle(SM,Array As String("")) Return SM End Sub 'Create and return a SeperatorMenuItem Object Public Sub MenuSeparator As Object Dim JO As JavaObject JO.InitializeNewInstance("javafx.scene.control.SeparatorMenuItem",Null) 'Add a style to the Separator ' JO.RunMethodJO("getStyleClass",Null).RunMethod("add",Array("cmenu")) AddStyle(JO,Array As String("mm-separator")) Return JO End Sub 'Create and return a TextMenuItem Object Public Sub MenuText(Text As String) As MenuItemTextClass Dim MI As MenuItemTextClass MI.Initialize(Me,"MI",Text) 'Add a style to the MenuItem ' MI.ASJavaObject.RunMethodJO("getStyleClass",Null).RunMethod("addAll",Array(Array As String("cmenu","menutext"))) AddStyle(MI.AsJavaObject,Array As String("mm-menutext")) Return MI End Sub 'Create and return a MenuCustom Object Public Sub MenuCustom(N As Node) As MenuCustomClass Dim MI As MenuCustomClass MI.Initialize(Me,"MC",N) If CustomNodeList.IsInitialized = False Then CustomNodeList.Initialize End If CustomNodeList.add(N) If mMenuType = MENUTYPE_MENU Then SetListener(MI,N) Else SetOnShownListener End If 'Add a style to the MenuItem ' MI.ASJavaObject.RunMethodJO("getStyleClass",Null).RunMethod("addAll",Array(Array As String("cmenu","menucustom"))) AddStyle(MI.AsJavaObject,Array As String("mm-menucustom")) Return MI End Sub 'Adjust the width of custom object on a Context Menu Private Sub SetOnShownListener Dim JO As JavaObject JO = CM Dim O As Object = JO.CreateEventFromUI("javafx.event.EventHandler","OnShown",Null) JO.RunMethod("setOnShown",Array(O)) Wait For (JO) OnShown_Event (MethodName As String, Args() As Object) Dim Width As Double = JO.RunMethod("getWidth",Null) For Each N As Node In CustomNodeList N.PrefWidth = Width Next End Sub 'Need to set the width for custom views if we want a tooltip as the label won't necessarily take the whole width of the menu Private Sub SetListener(MI As MenuCustomClass,N As Node) 'Code from here: https://stackoverflow.com/questions/28699152/how-to-get-menu-or-menuitem-width-in-javafx Dim O As Object = MenuManagerUtils.AsJO(N).CreateEvent("javafx.beans.value.ChangeListener","PopupChanged",Null) Dim Parent As JavaObject Parent = MI.AsJavaObject.RunMethodJO("parentPopupProperty",Null) Parent.RunMethod("addListener",Array(O)) Wait For (N) PopupChanged_Event (MethodName As String, Args() As Object) Dim ParentPopup As JavaObject Dim ParentPopupSkinProperty As JavaObject Dim MenuItemWidthProperty As JavaObject Dim MenuItemContainer As JavaObject ParentPopup = Args(2) ParentPopupSkinProperty = ParentPopup.RunMethodJO("skinProperty",Null) Dim O As Object = ParentPopupSkinProperty.CreateEvent("javafx.beans.value.ChangeListener","PopupChanged1",Null) ParentPopupSkinProperty.RunMethod("addListener",Array(O)) Wait For (ParentPopupSkinProperty) PopupChanged1_Event (MethodName As String, Args() As Object) MenuItemContainer = getAssociatedNode(MI) MenuItemWidthProperty = MenuItemContainer.RunMethod("widthProperty",Null) Dim O As Object = MenuItemWidthProperty.CreateEvent("javafx.beans.value.ChangeListener","PopupChanged2",Null) MenuItemWidthProperty.RunMethod("addListener",Array(O)) Wait For (MenuItemWidthProperty) PopupChanged2_Event (MethodName As String, Args() As Object) For Each N As Node In CustomNodeList N.PrefWidth = Args(2) Next End Sub 'Helper sub for the SetListener process Private Sub getAssociatedNode(MI As MenuCustomClass) As JavaObject Dim Menu As JavaObject Dim MenuSkin As JavaObject Dim Content As JavaObject Dim ItemsContainer As JavaObject Dim Children As List Dim MenuItemContainer As JavaObject If mMenuType = MENUTYPE_MENU Then Menu = MI.AsJavaObject.RunMethod("getParentPopup",Null) MenuSkin = Menu.RunMethod("getSkin",Null) Content = MenuSkin.RunMethod("getNode",Null) ItemsContainer = Content.RunMethod("getItemsContainer",Null) Children = ItemsContainer.RunMethod("getChildrenUnmodifiable",Null) For Each Child As Node In Children If GetType(Child) = "com.sun.javafx.scene.control.skin.ContextMenuContent$MenuItemContainer" Then MenuItemContainer = Child If MenuItemContainer.RunMethod("getItem",Null) = MI.AsObject Then Return MenuItemContainer End If End If Next Else End If Return Null End Sub 'Create and Return a CheckMenuItem and set a changelistener 'SelectedCChanged(MSB As MenuCheckBoxClass) Public Sub MenuCheckBox(Text As String) As MenuCheckBoxClass Dim MCB As MenuCheckBoxClass MCB.Initialize(Me,"CB",Text) 'Add a style to the Checkbox Menu Item AddStyle(MCB.AsJavaObject,Array As String("mm-checkbox")) Return MCB End Sub 'Create and return a MenuTitle Object, make it not hide when clicked Public Sub MenuTitle(Text As String) As MenuCustomClass Dim Lbl As Label Lbl.Initialize("") Lbl.Text = Text Dim MCC As MenuCustomClass MCC.Initialize(Me,"",Lbl) 'Add a style to the MenuItem AddStyle(MCC.AsJavaObject,Array As String("mm-title")) Return MCC End Sub 'Create and return a Label containing the defined FontAwesome Character Public Sub NewFontAwesome(FA As Char,Color As Paint) As Node Dim L As Label L.Initialize("") L.Font = fx.CreateFontAwesome(12) L.Text = FA L.TextColor = Color AddStyle(L,Array As String("mm-graphic","mm-fa-lbl")) Return L End Sub 'Create and return a Label containing the defined MaterialIcon Character Public Sub NewMaterialIcon(FA As Char,Color As Paint) As Node Dim L As Label L.Initialize("") L.Font = fx.CreateMaterialIcons(12) L.Text = FA L.TextColor = Color AddStyle(L,Array As String("mm-graphic","mm-ma-lbl")) Return L End Sub 'Helper to create an image view from a filepath/filename to add to the menu item Public Sub NewImage(FilePath As String,FileName As String) As ImageView Dim Img As ImageView Img.Initialize("") Img.SetImage(fx.LoadImageSample(FilePath,FileName,16,16)) AddStyle(Img,Array As String("mm-graphic-img")) Return Img End Sub Public Sub SetStyleSheet(FilePath As String,FileName As String) End Sub 'Get/Set a tag on the menumanager object Public Sub setTag(Tag As Object) MenuManagerUtils.AsJO(Me).runMethod("setUserData", Array(Tag)) End Sub Public Sub getTag As Object Return MenuManagerUtils.AsJO(Me).runMethod("getUserData", Null) End Sub