'***********************
' In Your Form
'***********************
Option Explicit
Private Sub Command1_Click()
Text1.Locked = Not Text1.Locked
End Sub
Private Sub Form_Load()
Call Hook(Text1.hwnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Unhook(Text1.hwnd)
End Sub
'***********************
' In a Standard Module
'***********************
Option Explicit
Public 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
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) _
As Long
Public Const GWL_WNDPROC = (-4)
Public Const GWL_STYLE = (-16)
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONUP = &H205
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const ES_READONLY = &H800&
Private mPrevProc As Long
Public Function TextBoxProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
If GetWindowLong(hwnd, GWL_STYLE) And ES_READONLY Then 'If the textbox is locked
Select Case uMsg
Case WM_LBUTTONDOWN, WM_LBUTTONUP, WM_RBUTTONDOWN, WM_RBUTTONUP
TextBoxProc = 0
Exit Function
End Select
End If
If mPrevProc = 0 Then
TextBoxProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
Else
TextBoxProc = CallWindowProc(mPrevProc, hwnd, uMsg, wParam, lParam)
End If
End Function
Public Sub Hook(hwnd As Long)
mPrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf TextBoxProc)
End Sub
Public Sub Unhook(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, mPrevProc)
mPrevProc = 0&
End Sub