Wednesday, May 14, 2008

Menu Pop Up

Option Explicit

Private Declare Function SendMessage Lib “user32″ Alias _
   “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Const LB_GETITEMRECT = &H198
Private Const LB_ERR = (-1)

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

Public Function GetRClickedItem(MyList As Control, _
   X As Single, Y As Single) As Long

  ‘PURPOSE: Determine which item was right clicked in a list
  ‘box, from the list_box’s mouse down event.  YOU MUST CALL THIS
  ‘FROM THE MOUSEDOWN EVENT, PASSING THE X AND Y VALUES FROM THAT
  ‘EVENT TO THIS FUNCTION

    ‘MYLIST: ListBox Control
    ‘X, Y: X and Y position from MyList_MouseDown

    ‘RETURNS:  ListIndex of selected item, or -1 if
    ‘a) There is no selected item, or b) an error occurs.

    Dim clickX As Long, clickY As Long
    Dim lRet As Long
    Dim CurRect As RECT
    Dim l As Long

    ‘Control must be a listbox
    If Not TypeOf MyList Is ListBox Then
        GetRClickedItem = LB_ERR
        Exit Function
    End If

    ‘get x and y in pixels
    clickX = X Screen.TwipsPerPixelX
    clickY = Y Screen.TwipsPerPixelY

    ‘Check all items in the list to see if it was clicked on
    For l = 0 To MyList.ListCount - 1

      ‘get current selection as rectangle
      lRet = SendMessage(MyList.hwnd, LB_GETITEMRECT, l, CurRect)

      ‘If the position of the click is in the this list item
       ‘then that’s  our Item

     If (clickX >= CurRect.Left) And (clickX <= CurRect.Right) _
       And (clickY >= CurRect.Top) And _
          (clickY <= CurRect.Bottom) Then

            GetRClickedItem = l
            Exit Function
        End If
    Next l
End Function

Private Sub Form_Load()
  List1.AddItem “Merah”
  List1.AddItem “Kuning”
  List1.AddItem “Hijau”
  mnuPopUp.Visible = False
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lItem As Long

If Button = vbRightButton Then
    lItem = GetRClickedItem(List1, X, Y)
                                        
        If lItem <> -1 Then
            List1.ListIndex = lItem
            PopupMenu mnuPopUp
        End If
End If

End Sub

 

Posted by Administrator at 05:53:04
Comments

One Response to “Menu Pop Up”

  1. Anonymous says:

    greate…code

Leave a Reply