Disable right click popupmenu of textboxes 6

[Crazyf]

hi guys.
I want to disable right click in textboxes. And that's why because i want to prevent the copy paste data from one textbox to another, i have created validations in textboxes, so every textbox has its own validation and i don't want the user copy paste data for one to another textbox. I have had a look at thread222-1070885, the code that refers there disables copy paste from clipboard and popupmenu appears when the user right cliks on the textbox, but i want something more than this, i want when the user right clicks in a textbox not appears the popupmenu. Any suggestions??
Any help will be much appreciated.

Thank you
in advanced

 

[BobRodes]

<you can display a customized context menu of your own when WM_CONTEXTMENU messasge is sent.

Hypetia, do you mean by using the Menu Editor and PopupMenu, or is there a way to do that via API?

 

[BobRodes]

Never mind. Here's a piece of code to build a custom popup menu:

http://www.vbfrance.com/codes/MENU-CREE-DYNAMIQUEMENT-SANS-PASSER-ASSISTANT-VB_27410.aspx

All the comments are in French, but the code works as advertised.

Bob

 

[Crazyf]

The what i did is the code of hypetia that mentioned in thread222-1070885: Disable Paste function. If I run the program it seems that is working. But if run step over F8, if i have a statement for example msgbox "hello" running this function,

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_PASTE Then uMsg = 0
WindowProc = CallWindowProc(lppwp, hWnd, uMsg, wParam, lParam) 'THIS STATEMENT CALLS WITHOUT STOPPING.......
End Function

i don't know why, but never ends. Never goes to the next statement of msgbox "hello" Why does this happen Hypetia?
Any help from anyone? I dont know what exactly does the function WindowProc and i don't understand the reason i have this problem. Thanks everybody for your replies.

 

[BobRodes]

WindowProc is there to provide a means to replace the existing procedure. So you can see in this window proc that we are first disabling any order (contained in uMsg) to execute a paste. Then we're calling the normal window proc. This is "subclassing".

You can't reliably use the debug step through capability here. Have a look at this: thread222-701611

Bob

 

[Crazyf]

So, if i have well understood, the "problem" i mentioned above, is not exactly problem. The call api windowproc calls anytime occurs an event either this is a messagebox appears, either the user clicks on the form or any object, whatever. A last question, i studied a little for api and i read that Microsoft offers two 32-bit operating systems—Windows 98 and Windows NT. Do Api causes problems in Windows XP OS?

Thanks everyone
in advanced

 

[strongm]

>Do Api causes problems in Windows XP OS?

No, no problems: the API used by XP is the NT API

 

[Hypetia]

>Hypetia, do you mean by using the Menu Editor and PopupMenu, or is there a way to do that via API?
Yes, this is the easiest and recommended method. If you want to do it the hard way (via API), see these threads.
thread222-556072
thread713-599701

>the "problem" i mentioned above, is not exactly problem
You are certainly right. The window procedure processes a large number of messages and apprears to execute endlessly when in debug mode. So it's not a good idea to debug your code when your window is subclassed.

See thread222-1364428, specially my last post, for some cautions regarding subclassing in VB6.

 

[BobRodes]

<you can display a customized context menu of your own [etc]

Well, I got interested and wrote one. It seems to work fine. I borrowed plenty of ideas from the French guy, and swiped Hypetia's code to disable the context menu.

Here's the code:[tt]
'This code goes in a Form1 form, with at least a Text1 textbox.

Option Explicit

Private Sub Form_Load()
SetContextMenu Text1, False 'Disable the context menu for Text1
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
DoCustomMenu Text1 'Creates the custom menu when right clicking Text1
End If
End Sub

Private Sub DoCustomMenu(cBox As TextBox)
Dim cSelStart As Integer
Select Case ShowCustomEditPopup(Me, cBox) 'Return values are the wId value in the MENUITEMINFO type
Case 100
DoSelectAll cBox
Case 102
DoDelete cBox
Case 103
DoPaste cBox
Case 104
DoCopy cBox
Case 105
DoCut cBox
Case 107
DoUndo cBox
End Select
End Sub

'And this code goes in a standard module:

Option Explicit

'Constants and SendMessage function, needed to emulate the context menu functions

Private Const EM_CANUNDO = &HC6
Private Const EM_UNDO = &HC7
Private Const WM_CUT = &H300
Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302
Private Const WM_CLEAR = &H303

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

'Constants, Types, and Functions for the popup menu

Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MIIM_STATE = &H1
Private Const MIIM_SUBMENU = &H4
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_RETURNCMD = &H100&
Private Const TPM_RIGHTBUTTON = &H2&
Private Const MFT_STRING = &H0
Private Const MFT_SEPARATOR = &H800&
Private Const MFS_ENABLED = &H0
Private Const MFS_DISABLED = &H3

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Private Type POINTAPI
X As Long
Y As Long
End Type

Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal hwnd As Long, ByVal lptpm As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long

'Functions to disable context menu (Hypetia)
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
Const GWL_WNDPROC = (-4)
Dim lppwp& '(Long) Pointer to Previous Window Procedure

Public Function ShowCustomEditPopup(cForm As Form, cBox As TextBox) As Long
Dim pMenuInfo As MENUITEMINFO
Dim pPositionCursor As POINTAPI
Dim lHandleMenu As Long
Dim lHandleMenuSel(7) As Long 'one for each menu selection, including separators
Dim i As Integer
'initialize popup menu window and each of the 8 selections
lHandleMenu = CreatePopupMenu
For i = 0 To 7
lHandleMenuSel(i) = CreatePopupMenu
Next

'Set up each menu item, using the MENUITEMINFO type. Note that the menu items are pushed
'onto a stack, meaning that the first item inserted will be the last selection on the menu.

With pMenuInfo
.cbSize = Len(pMenuInfo) 'Size of the structure itself in bytes.
.fType = MFT_STRING
.fState = MFS_ENABLED
.dwTypeData = "Select All" 'What the menu item will say
.cch = Len(.dwTypeData)
'If fType is MFT_STRING, the length of the string. Determines the width of the menu.
.wID = 100
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
'Packages information about the item into a hex value, which is then unpackaged by the
'InsertMenuItem routine and used to render the selections. ID is basically the key.
'Type is either separator or string value in this app, can also have several other values.
'State is enabled, disabled, checked, etc. All the selections are submenus, in that they
'are items in the main popup menu whose handle is stored in the lHandelMenu variable.
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

'Lower Separator
With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_SEPARATOR
.wID = 101
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_STRING
.fState = IIf(cBox.SelText = "", MFS_DISABLED, MFS_ENABLED)
'Disable the Delete selection if no text is selected
.dwTypeData = "Delete"
.cch = Len(.dwTypeData)
.wID = 102
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_STRING
.fState = IIf(Not IsNumeric(Clipboard.GetText), MFS_DISABLED, MFS_ENABLED)
'Disable the Paste selection if the Clipboard contains non-numeric text
.dwTypeData = "Paste"
.cch = Len(.dwTypeData)
.wID = 103
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_STRING
.fState = IIf(cBox.SelText = "", MFS_DISABLED, MFS_ENABLED)
'Disable the Copy selection if no text is selected
.dwTypeData = "Copy"
.cch = Len(.dwTypeData)
.wID = 104
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_STRING
.fState = IIf(cBox.SelText = "", MFS_DISABLED, MFS_ENABLED)
'Disable the Cut selection if no text is selected
.dwTypeData = "Cut"
.cch = Len(.dwTypeData)
.wID = 105
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_SEPARATOR
.wID = 106
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

With pMenuInfo
.cbSize = Len(pMenuInfo)
.fType = MFT_STRING
.fState = IIf(SendMessage(cBox.hwnd, EM_CANUNDO, 0, 0) = 0, MFS_DISABLED, MFS_ENABLED)
'Disable the Undo selection if there is no possible Undo
.dwTypeData = "Undo"
.cch = Len(pMenuInfo.dwTypeData)
.wID = 107
.fMask = MIIM_ID Or MIIM_TYPE Or MIIM_STATE Or MIIM_SUBMENU
End With
InsertMenuItem lHandleMenu, 0, True, pMenuInfo

GetCursorPos pPositionCursor 'Get cursor position, store it to pPositionCursor type
ShowCustomEditPopup = TrackPopupMenuEx(lHandleMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON _
Or TPM_RETURNCMD, pPositionCursor.X, pPositionCursor.Y, cForm.hwnd, ByVal 0&)
'TPM_LEFTALIGN: Left Align menu at the cursor position
'TPM_RIGHTBUTTON: Allows user to make menu selections with either button
'TPM_RETURNCMD: Sends wId of selected item as return value

'Clean up
DestroyMenu lHandleMenu
For i = 0 To 7
DestroyMenu lHandleMenuSel(i)
Next
Exit Function
End Function

'Hypetia's code for disabling context menu.
Function WindowProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
If uMsg = &H7B& Then uMsg = 0 'Disable WM_CONTEXTMENU
WindowProc = CallWindowProc(lppwp, hwnd, uMsg, wParam, lParam)
End Function

Sub SetContextMenu(Txt As TextBox, bEnable As Boolean)
If bEnable Then
If lppwp Then SetWindowLong Txt.hwnd, GWL_WNDPROC, lppwp
Else 'subclass the textbox window, by redirecting the standard window procedure to WindowProc
Dim Ret As Long
Ret = SetWindowLong(Txt.hwnd, GWL_WNDPROC, AddressOf WindowProc)
If lppwp = 0 Then lppwp = Ret
End If
End Sub

'Replacement menu routines
Public Sub DoUndo(cBox As TextBox)
If SendMessage(cBox.hwnd, EM_CANUNDO, 0, 0) <> 0 Then
SendMessage cBox.hwnd, EM_UNDO, 0, 0
End If
End Sub

Public Sub DoDelete(cBox As TextBox)
SendMessage cBox.hwnd, WM_CLEAR, 0, 0
End Sub

Public Sub DoCut(cBox As TextBox)
SendMessage cBox.hwnd, WM_CUT, 0, 0
'Clipboard.SetText cBox.SelText
'SendMessage cBox.hwnd, WM_CLEAR, 0, 0
End Sub

Public Sub DoCopy(cBox As TextBox)
SendMessage cBox.hwnd, WM_COPY, 0, 0
'Clipboard.SetText cBox.SelText
End Sub

Public Sub DoSelectAll(cBox As TextBox)
With cBox
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub

Public Sub DoPaste(cBox As TextBox)
SendMessage cBox.hwnd, WM_PASTE, 0, 0
End Sub
[/tt]

HTH

Bob

 

[Hypetia]

[tt]Dim lHandleMenuSel(7) As Long
...
For i = 0 To 7
lHandleMenuSel(i) = CreatePopupMenu
Next
...
For i = 0 To 7
DestroyMenu lHandleMenuSel(i)
Next
[/tt]
I am not sure what above code is meant for. I commented the above code and program still runs fine.

I have a couple of suggestions.

1. Instead of popping the menu on right mouse button down event, you should show it on WM_CONTEXTMENU message which you currently suppress in your code. This will ensure that the user gets the context menu using mouse as well as keyboard. See my first post above.

2. Instead of InsertMenuItem, you can use the simpler version InsertMenu, which will greatly reduce your menu creation code.

Also you don't need to send EM_CANUNDO before EM_UNDO. You already do that when creating the "Undo" menu item.

Last but not least, like all other actions, if you want to "DoSelectAll" using API as well, send the EM_SETSEL message. ;-)
[tt]SendMessage cBox.hwnd, EM_SETSEL, 0, ByVal -1& 'select all[/tt]

 

[Crazyf]

That's great Bob, i am just worry for myself because i am new to vb6 and i don't have the experience creating subclasses and context popup menus. I hope, i can do that earlier. I have a generally question to do about subclasses, for example how do we know that &HC6 is EM_CANUNDO, or &H800& is MFT_SEPARATOR, whatever, how do we know these consts and their values?

Thank you all so much again.

 

[Hypetia]

VB6 ships with a utility called API Viewer. You can use this application to find the value of various API constants and function and type declarations.

However, the API Viewer that ships with VB6 is quite outdated and an enhanced version of API Viewer is available for free download featuring a larger and more comprehensive API database.

http://www.activevb.de/rubriken/apiviewer/index-apiviewereng.html

 

[dilettante]

Buyer beware though

I find myself going back to the original API Viewer with either the original or 3rd party more-complete databases.

They all have omissions, they all have errors. I've been back to the C header files in the Platform SDK many a time to unravel the right Const, Type, Enum, or Declare I needed.

That "rubriken" version also has a wonky UI, almost like the guy never used a Windows application before.

 

[BobRodes]

<I am not sure what above code is meant for.
I started off with the French guy's code that I referenced above. He had a couple of levels of submenus. I was thinking that I had to create a variable for each menu selection, but I see from your post that that's not the case. I only need to create a variable for the menu itself, and then insert items into it.

Thanks for all the other improvements, too, Hypetia. Another star for you!

<how do we know that &HC6 is EM_CANUNDO, or &H800& is MFT_SEPARATOR, whatever, how do we know these consts and their values?
Read up on windows.h and winuser.h, which you can find on your disk if you have Visual Studio installed.

 

[BobRodes]

By the way, Crazyf, I don't mean to suggest by saying this that one shouldn't use the API viewer. But if you want to get your information "straight from the horse's mouth", that's where to get it.

Bob