在vb中实现真正锁定的带自定义菜单的文本控件

在vb中实现真正锁定的带自定义菜单的文本控件

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
///这个东西的出台，是由于一个网友的帖子,太气人，我才写的，很匆忙，又什么问题，请指出！谢谢////
//////////////////////////QQ:9181729/////////////mail:shawfile@163.net/////////////http://shawls.yeah.net
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

vb中的textbox控件，虽然可以设置locked属性来实现对文本的锁定，但是，如果用户使用右键菜单，那么就不起作用了，仍然可以对文本进行编辑，有没有办法使用户不能对文本框进行编辑而且替换掉控件的那个右键菜单呢？

完整实现代码如下：
’核心代码的代码
''''uTextBox 是你要屏蔽的文本控件 m_Menu 是你要弹出的菜单 m_Read标记是否锁定
Private Sub uTextBox_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And m_Read = True Then
OldWindowProc = GetWindowLong(uTextBox.hWnd, GWL_WNDPROC)
'''' 取得窗口函数的地址
Call SetWindowLong(uTextBox.hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage)
'''' 用SubClass_WndMessage代替窗口函数处理消息
End If
End Sub

Private Sub uTextBox_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And m_Read = True Then
Call SetWindowLong(uTextBox.hWnd, GWL_WNDPROC, OldWindowProc)
'''' 恢复窗口的默认函数
'''' 弹出自定义菜单
If Not m_Menu Is Nothing Then
If TypeOf m_Menu Is Menu Then
PopupMenu m_Menu
End If
End If
End If
End Sub

''''以下放置在模块中

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 SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Function SubClass_WndMessage(ByVal hWnd As OLE_HANDLE, ByVal Msg As OLE_HANDLE, ByVal wp As OLE_HANDLE, ByVal lp As Long) As Long
If Msg <> WM_CONTEXTMENU Then
SubClass_WndMessage = CallWindowProc(OldWindowProc, hWnd, Msg, wp, lp)
'''' 如果消息不是WM_CONTEXTMENU，就调用默认的窗口函数处理
Exit Function
End If
SubClass_WndMessage = True
End Function

''''一下是一个完整的自定义的控件的例子“
''''下面放置到一个自定义控件中
VERSION 5.00
Begin VB.UserControl UTextBox
ClientHeight = 525
ClientLeft = 0
ClientTop = 0
ClientWidth = 1425
ScaleHeight = 525
ScaleWidth = 1425
Begin VB.TextBox uTextBox
Appearance = 0 ''''Flat
BackColor = &H80000018&
Height = 345
Left = 30
TabIndex = 0
Top = 90
Width = 1275
End
End
Attribute VB_Name = "UTextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_BackColor As OLE_COLOR ''''颜色
Private m_MaxLength As Integer ''''长度
Private m_TextAlig As VBRUN.AlignmentConstants ''''文本位置
Private m_Menu As Menu ''''自定义菜单
Private m_Read As Boolean ''''是否可读
Private m_Enabled As Boolean ''''Enabled
''''Private m_MulitLine As Boolean ''''换行
Private Const m_DefBackColor = &H80000018 ''''默认文本背景颜色
Public Event Change() ''''文本修改事件
Public Event Click() ''''click事件

Private Sub UserControl_Initialize()
Call UserControl_Resize
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Let BackColor = PropBag.ReadProperty("BackColor", m_DefBackColor)
Let MaxLength = PropBag.ReadProperty("MaxLength", 0)
Let Text = PropBag.ReadProperty("Text", "")
Let Alignment = PropBag.ReadProperty("Alignment", 0)
Set Menu = PropBag.ReadProperty("Menu", Nothing)
Let ReadOnly = PropBag.ReadProperty("Read", False)
Let Enabled = PropBag.ReadProperty("Enabled", True)
'''' Let uTextBox.MultiLine = PropBag.ReadProperty("MultiLine", False)
''''Let uTextBox.ScrollBars = PropBag.ReadProperty("ScrollBars", 0)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("BackColor", BackColor, m_DefBackColor)
Call PropBag.WriteProperty("MaxLength", MaxLength, 0)
Call PropBag.WriteProperty("Text", Text, "")
Call PropBag.WriteProperty("Alignment", Alignment, 0)
Call PropBag.WriteProperty("Menu", Menu, Nothing)

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有