使PopupMenu出现在VB6中TreeView的选定项目上

时间:2011-07-17 20:39:11

标签: vb6 keydown popupmenu

我在VB6中使用了一个TreeView,它在右键单击Node时使用PopupMenu。由于VB6 PopupMenu将其位置默认为鼠标坐标,因此菜单出现在正确的位置。

我想要完成的是,当选择TreeView节点时,Popupmenu也会出现在KeyDown事件的正确位置。我怎么能这样做?

1 个答案:

答案 0 :(得分:2)

您需要获取该项目的坐标。为此你需要先获得它的句柄。当你得到矩形时,你必须将它翻译成形状坐标。

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function MapWindowPoints Lib "user32.dll" (ByVal hwndFrom As Long, ByVal hwndTo As Long, ByRef lppt As Any, ByVal cPoints As Long) As Long

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Type RECTF
  Left As Single
  Top As Single
  Right As Single
  Bottom As Single
End Type

Private Const TV_FIRST As Long = &H1100&
Private Const TVM_GETITEMRECT As Long = (TV_FIRST + 4)
Private Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
Private Const TVGN_CARET As Long = &H9&


Private Function GetSelectedItemRect(ByVal tv As TreeView, ByRef outRect As RECTF) As Boolean
  Dim hItem As Long
  hItem = SendMessage(tv.hwnd, TVM_GETNEXTITEM, TVGN_CARET, ByVal 0&)

  If hItem Then
    Dim r As RECT
    r.Left = hItem

    If SendMessage(tv.hwnd, TVM_GETITEMRECT, 1, r) Then
      MapWindowPoints tv.hwnd, Me.hwnd, r, 2

      outRect.Left = Me.ScaleX(r.Left, vbPixels, Me.ScaleMode)
      outRect.Top = Me.ScaleY(r.Top, vbPixels, Me.ScaleMode)
      outRect.Right = Me.ScaleX(r.Right, vbPixels, Me.ScaleMode)
      outRect.Bottom = Me.ScaleY(r.Bottom, vbPixels, Me.ScaleMode)

      GetSelectedItemRect = True
    End If
  End If

End Function

用法:

Dim r As RECT

If GetSelectedItemRect(TreeView1, r) Then
  PopupMenu whatever, , r.Right, r.Top
End If