Hi all.
I saw this code (below)in another forum. It creats a popupmenu when you right click on the form...just wondering how you make it apply to a text box, so that when you right-click on a text box, it will come up.
Any help much appreaciated.
Option Explicit
Const MENU_OPEN = 400
Const MENU_SAVE = 401
Const MENU_CHECKED = 402
Const MENU_DISABLED = 403
Const MENU_PRINT = 404
Const MENU_EXIT = 405
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TPMPARAMS
cbSize As Long
rcExclude As RECT
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreateMenu Lib "user32" () As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As Long, lpTPMParams As TPMPARAMS) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Const MF_BYPOSITION = &H400&
Private Const MF_STRING = &H0&
Private Const MF_POPUP = &H10&
Private Const MF_DISABLED = &H2&
Private Const MF_CHECKED = &H8&
Private Const MF_GRAYED = &H1&
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_CENTERALIGN = &H4&
Private Const TPM_LEFTBUTTON = &H0&
Private Const TPM_RIGHTALIGN = &H8&
Private Const TPM_RIGHTBUTTON = &H2&
Private Const TPM_RETURNCMD = &H100&
Dim hMenu, hSubMenu As Long
Dim pt As POINTAPI
Private Sub Form_Load()
Me.ScaleMode = vbPixels
hMenu = CreateMenu()
hSubMenu = CreatePopupMenu()
AppendMenu hSubMenu, MF_STRING, MENU_OPEN, "Open"
AppendMenu hSubMenu, MF_STRING, MENU_SAVE, "Save"
AppendMenu hSubMenu, MF_STRING Or MF_CHECKED, MENU_CHECKED, "Checked"
AppendMenu hSubMenu, MF_STRING Or MF_GRAYED, MENU_DISABLED, "Disabled"
AppendMenu hSubMenu, MF_STRING, MENU_PRINT, "Print"
AppendMenu hSubMenu, MF_STRING, MENU_EXIT, "Exit"
AppendMenu hMenu, MF_STRING Or MF_POPUP, hSubMenu, "File"
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, myX As Single, myY As Single)
Dim rc As RECT
Dim retcmd As Long
If Button = vbRightButton Then
pt.x = myX
pt.y = myY
ClientToScreen Me.hwnd, pt
retcmd = TrackPopupMenu(hSubMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, pt.x, pt.y, 0, Me.hwnd, rc)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
DestroyMenu hMenu
DestroyMenu hSubMenu
End Sub
