Question

vb如何创建只读文本框，求高人帮忙！

如果是Text1.Locked=True的话，可以防止修改，但是仍然能够执行“复制”及“粘贴”命令。如何禁止“复制”及“粘贴”命令？
可以用代码，或者属性编辑什么的。求高人帮忙！

Answer 1

VB文本框的右键菜单是系统默认提供的,在很多时候我们不想看见它,或者希望能够修改它.

方法1:替换菜单.

Form1.frm:

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3165
ClientLeft = 60
ClientTop = 375
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3165
ScaleWidth = 4680
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text1
Height = 600
Left = 1035
TabIndex = 0
Top = 990
Width = 2625
End
Begin VB.Menu mnu
Caption = "123"
Visible = 0 'False
Begin VB.Menu mnu1
Caption = "321"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
Text1.Enabled = False
Me.PopupMenu mnu
Text1.Enabled = True
End If
End Sub

这个方法其实很简单,就是自己定义一个菜单,然后利用窗口的PopupMenu方法替换掉Text1的默认菜单.这里要注意的就是在弹出菜单之前一定要把文本框Enabled设置为False.

这个方法的缺点就是,只能修改右键菜单,却没办法彻底屏蔽它.

方法2:替换文本框的消息响应函数

写一个bas,内容为:

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC = (-4)
Private Const WM_RBUTTONDOWN = &H204

Private m_lpPrevDisableRButtonDownWindowProc As Long

Private Function DisableRButtonDownWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_RBUTTONDOWN Then
Exit Function
End If
DisableRButtonDownWindowProc = CallWindowProc(m_lpPrevDisableRButtonDownWindowProc, hwnd, uMsg, wParam, lParam)
End Function

Public Function HookText(ByVal hwnd As Long) As Boolean
m_lpPrevDisableRButtonDownWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf DisableRButtonDownWindowProc)
End Function

Public Function UnHookText(ByVal hwnd As Long) As Boolean
Call SetWindowLong(hwnd, GWL_WNDPROC, m_lpPrevDisableRButtonDownWindowProc)
End Function

添加这个bas到工程,然后重写窗口事件:

Option Explicit

Private Sub Form_Load()
HookText Text1.hWnd
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnHookText Text1.hWnd
End Sub

这样Text1就不会弹出任何菜单了.

如果希望替换默认菜单为自己的菜单,那么修改DisableRButtonDownWindowProc为:

Private Function DisableRButtonDownWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_RBUTTONDOWN Then
Form1.PopupMenu Form1.mnu '自己的自定义弹出菜单
Exit Function
End If
DisableRButtonDownWindowProc = CallWindowProc(m_lpPrevDisableRButtonDownWindowProc, hwnd, uMsg, wParam, lParam)
End Function

即可.

Answer 2

楼上的很详细了。。还有一种方法，直接提示用户不允许右单击:
Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
MsgBox "不能允许复制"
End If
End Sub
这样在弹出菜单的一瞬间会跳出个模态对话框，这样就看不到弹出的菜单了。。

Answer 3

Private Sub text1_mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'text的鼠标mousedown事件
Text1.Locked = True '锁定text文本框内容不被删除
If Button = 2 Then '判断鼠标右键的使用
MsgBox "请不要使用鼠标右键", , "警告" '弹出对话框，禁止右键复制
End if
End Sub

Answer 4

Text1.enabled=false