La Web del Programador: Comunidad de Programadores
 
    Pregunta:  32545 - EVITAR MENU FLOTANTE EN UN TEXBOX
Autor:  Vidal Figueroa
Hola Amigos,

Tengo un Problema no logro eliminar el menu que sale cuando doy click derecho sobre un TexBox. ¿Si alguien puede decirmelo por favor?

Gracias

  Respuesta:  Sahid Ra Gutierrez Cruz
Mira lo que creo que quieres hacer es que no pegen algun texto, y si eso es puedes usando este codigo simple:

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Text1.Locked = True
End If
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Locked = False
End Sub

OJO solo funciona para el mouse, pero al menos ya tienes idea de lo quepuedes hacer para el teclado :D

  Respuesta:  Javier Aparicio Rodríguez
Hola.
Puedes hacerlo mediante una subclasificación de ventanas.
Para ello crea un formulario "Form1" con un textbox "Text1"
Al cargar y descargar el formulario añade el siguiente código:

Private Sub Form_Load()
OldWindowProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
Call SetWindowLong(Text1.hwnd, GWL_WNDPROC, AddressOf SubClase_Text1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(Text1.hwnd, GWL_WNDPROC, OldWindowProc)
Set Form1 = Nothing
End Sub

En un módulo aparte (Module1) añade el suiguiente código:

Global Const WM_RBUTTONUP& = &H205
Global Const WM_LBUTTONUP& = &H202
Global Const GWL_WNDPROC = (-4)

Public OldWindowProc As Long

Declare Function GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long)
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Public Function SubClase_Text1(ByVal hwnd As Long, ByVal Msg As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim rp&
If Msg = WM_RBUTTONUP Then
rp = SendMessageBynum(hwnd, WM_LBUTTONUP, wp, lp)
Else
SubClase_Text1 = CallWindowProc(OldWindowProc, hwnd, Msg, wp, lp)
End If
End Function

Un saludo.