Miscellaneous Textbox Functions

[da_silvy]

Suppressing default popup menu on a text box

Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
 
Private Sub TextBox_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
    If Button = vbRightButton Then
        ' Avoid the 'disabled' gray text by locking updates
        LockWindowUpdate TextBox.hwnd
        
        ' A disabled TextBox will not display a context menu
        TextBox.Enabled = False
        
        ' Give the previous line time to complete
        DoEvents
        
        ' Display our own context menu
        PopupMenu mnuPopup
        
        ' Enable the control again
        TextBox.Enabled = True
        
        ' Unlock updates
        LockWindowUpdate 0&
    End If
End Sub

[da_silvy]

Disabling context menu

In a module:

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) As Long
 
Const GWL_WNDPROC = (-4)
Const WM_CONTEXT = &H7B
 
Private WndProcOld As Long
 
Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_CONTEXT Then Exit Function
    WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, _
    wParam&, lParam&[b][/b])
End Function
 
Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, _
    AddressOf WindProc)
End Sub
 
Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

In a form:

Private Sub Form_Load()
    SubClassWnd TextBox.hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnSubclassWnd TextBox.hwnd
End Sub

This doesn't affect the right click message in any way.

[da_silvy]

Disabling copy, cut and paste in a textbox

In a module:

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) As Long
 
Const GWL_WNDPROC = (-4)
 
Const WM_COPY = &H301
Const WM_PASTE = &H302
Const WM_CUT = &H300
 
Private WndProcOld As Long
 
Public Function WindProc(ByVal hwnd As Long, ByVal wMsg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If wMsg = WM_COPY Or wMsg = WM_PASTE Or wMsg = WM_CUT Then Exit Function
    WindProc = CallWindowProc(WndProcOld&, hwnd&, wMsg&, _
    wParam&, lParam&)
End Function
 
Sub SubClassWnd(hwnd As Long)
    WndProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, _
    AddressOf WindProc)
End Sub
 
Sub UnSubclassWnd(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, WndProcOld&
    WndProcOld& = 0
End Sub

In a form:

Private Sub Form_Load()
    SubClassWnd TextBox.hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    UnSubclassWnd TextBox.hwnd
End Sub