Now I have a real question, though. As a keyboard guy, I almost always use the "Right-click" keyboard button to open and use popup menus in Windows. How can I add this functionality to my shiny new popup menu?
Note that if the popup menu is activated using this method, I'd ideally want the accelerator keys underlined just like it works in Windows proper.
One more tip for the OP is that if you want to disable the popup when there is no node selected, change the mouseup code to something like this:
Code:
If Button = vbRightButton And Not (Me.tree.SelectedItem Is Nothing) Then Me.PopupMenu mnuMain(6)
I'm also doing this for a treeview, and I think it would be nice to have different popup menu choices for when there is no selected item, so I'm going with something like this:
Code:
Private Sub Treeview1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim blnSelected As Boolean
If Button = vbRightButton Then
blnSelected = Not (Me.Treeview1.SelectedItem Is Nothing)
mnuPopup(1).Visible = Not blnSelected ' Expand All
mnuPopup(2).Visible = Not blnSelected ' Collapse All
mnuPopup(3).Visible = blnSelected ' Rename
mnuPopup(4).Visible = blnSelected ' Delete
mnuPopup(5).Visible = blnSelected ' Separator
mnuPopup(6).Visible = blnSelected ' Properties
PopupMenu mnuMain(6) ' Or whatever your popup menu is
End If
End Sub
In this basic example, (mine is a bit more involved), if there is no node selected the popup menu choices are:
Expand All
Collapse All
If there is an item selected, then the popup choices are:
To see what I mean, open up your My Documents and select a file. Right click on it and you see a context menu. Select a different file to get rid of the popup menu and then hit the Right Click keyboard button. You see the same basic popup menu, but this time the accelerator keys are underlined.
It's similar to how you don't see the accelerator keys in the menuing system of VB programs unless you activate them with an [Alt] key combination. (I'm aware that this is an OS setting.)
It's super helpful for us keyboard users, though the accelerator underlining isn't criticial. (But it sure would be nice.) I never single-click to rename a file; I always hit the keyboard RightClick followed by M.
The right-click key apparently has no constant defined for it in the object library; I just ran through all of them and didn't find one with the correct mapping. It's KeyCode 93. On the plus side, it underlines the accelerator keys exactly as I wanted. Way to go, OS!
The only problem is that the keyboard is popping up the menu where the mouse is, instead of where the highlighted node is. Once I get that straightened out, I'll post the code here for the edification of the OP and any others who might do a search on this in the future.
Determining the x and y coordinates of the selected item in a treeview was a huge PITA, since I had to do it manually. Because of this, I included constants you can play with if your treeview doesn't use images or does use root lines.
One completely insurmountable but acceptable issue is that I have no idea how to determine whether the treeview has been scrolled to the right. If it is, the keyboard context menu will appear a bit too far to the right, but it still looks fine. Good enough for government work, certainly.
The following code goes into your form's module:
Code:
Private Sub Treeview1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then ContextMenu
End Sub
Private Sub Treeview1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 93 Then ContextMenu False
End Sub
' Note that the form the treeview is on needs to have the same
' font as the treeview. If this is an issue, set the form font at the
' beginning of this function and then set it back on exit.
Public Sub ContextMenu(Optional ByVal pblnUseMouseCoords As Boolean = True)
Const RowMargin = 3 ' May need to trial & error this value if font changes
Const NodeIndent = 19 ' May need to trial & error this one as well
Dim nod As MSComctlLib.Node
Dim lngRows As Long
Dim lngRowHeight As Long
Dim lngIndex As Long
Dim lngLevel As Long
Dim x As Long
Dim y As Long
With Me
If pblnUseMouseCoords Then
' Change mnuMain(6) to the name of your menu
.PopupMenu .mnuMain(6)
Else ' Determine coords of selected node manually
' Basic height of a node is the height of the font plus the margin
lngRowHeight = .TextHeight("X") + (RowMargin * Screen.TwipsPerPixelY)
' Determine how many visible nodes precede the selected one
With .Treeview1
' If no node selected show context menu in upper left of treeview
If .SelectedItem Is Nothing Then
x = .Left + (NodeIndent \ 2) * Screen.TwipsPerPixelX
y = .Top + (lngRowHeight \ 2)
Else
lngRows = 0
For Each nod In .Nodes
If nod.Visible Then
lngRows = lngRows + 1
If nod.Index = .SelectedItem.Index Then Exit For
End If
Next
' Determine how deep the selected node is nested
' This fails acceptably if the treeview is scrolled to the right
lngLevel = 0
lngIndex = nod.Index
Do While Not (.Nodes(lngIndex).Parent Is Nothing)
lngLevel = lngLevel + 1
lngIndex = .Nodes(lngIndex).Parent.Index
Loop
' Calculate the coordinates
x = .Left + ((NodeIndent \ 2) + (lngLevel * (.Indentation + NodeIndent))) * Screen.TwipsPerPixelX
y = .Top + (lngRowHeight * lngRows) - (lngRowHeight \ 2)
' Clear nod object
Set nod = Nothing
End If
End With
' Change mnuMain(6) to the name of your menu
.PopupMenu .mnuMain(6), , x, y
End If
End With
End Sub
Edited to display the keyboard context menu in the upper left of the treeview if no node is selected, as opposed to where the mouse cursor is. Also added the Dim x and Dim y statements.
Last edited by Ellis Dee; Apr 3rd, 2007 at 12:51 PM.
I'm recalling a 'hittest'?
not sure if it was for this purpose
you might want to search around the forums for it.
HitTest tests for the mouse position. I need to know the actual coordinates of the selected item regardless of where the mouse is. (The mouse may not even be over the treeview at all.)
Is it possible to use the same Context menu for multiple controls and/or forms by passing the sender control?
I have 2 listviews.. and when i right click I can certainly get both listviews to show the menu options i've created. But for the resulting function, I need to pass the "sender" so that it knows if it is from listview1 or listview2.
How can I do that?
Last edited by DssTrainer; Aug 27th, 2007 at 01:00 PM.
I can't be totally specific because I don't know what is on the menu or what the code is that you have to do something when a menu item is selected, but, if you have the code for your menu in the menu's click event, move the code to a Sub routine.
As a part of calling the Sub, pass the ListView name. If you can give me an example of what you are doing now, I can give you an example of what I mean. You would set the name of the sub in the listview click event or something.
I can't be totally specific because I don't know what is on the menu or what the code is that you have to do something when a menu item is selected, but, if you have the code for your menu in the menu's click event, move the code to a Sub routine.
As a part of calling the Sub, pass the ListView name. If you can give me an example of what you are doing now, I can give you an example of what I mean. You would set the name of the sub in the listview click event or something.
Well that is what I'm doing, but I don't know how to get/pass the sender.
Currently I have:
Code:
Private Sub ListView1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Item As mscomctllib.ListItem
Set Item = ListView1.SelectedItem
If Not Item Is Nothing Then
If Button = 2 Then
For Each Item In ListView1.ListItems
If Item.Selected Then
iCount = iCount + 1
If iCount > 1 Then
Exit For
End If
End If
Next Item
If iCount = 1 Then
PopupMenu mnuTasks
Else
PopupMenu mnulv2context
End If
End If
End If
End Sub
Private Sub ListView2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Item As mscomctllib.ListItem
Set Item = ListView2.SelectedItem
If Not Item Is Nothing Then
If Button = 2 Then
PopupMenu mnulv2context
End If
End If
End Sub
''''' mnulv2context has 2 options "Match Inclusive" & "Match Exclusive"
Private Sub mnuMatchInclusive_Click()
SelectMatchingTask ListView2, False
End Sub
Public Sub SelectMatchingTask(lv As ListView, bExclusive As Boolean)
Dim itmx As ListItem
Dim sTaskName As String
If Not lv.SelectedItem Is Nothing Then
sTaskName = lv.SelectedItem.SubItems(6)
If sTaskName <> "" Then
For Each itmx In lv.ListItems
If bExclusive = True Then
itmx.Checked = False
End If
If itmx.SubItems(6) = sTaskName Then
itmx.Checked = True
End If
Next itmx
End If
End If
End Sub
In the mnuMatchInclusive_click sub, I am specifying the listview by name, but i need to get this programatically and pass that to my sub
I can't be totally specific because I don't know what is on the menu or what the code is that you have to do something when a menu item is selected, but, if you have the code for your menu in the menu's click event, move the code to a Sub routine.
As a part of calling the Sub, pass the ListView name. If you can give me an example of what you are doing now, I can give you an example of what I mean. You would set the name of the sub in the listview click event or something.
Not sure if you overlooked my reply to this above when i re-replied with the treeview reply.