在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 IfEnd 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 IfEnd 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 = TrueEnd Function
'一下是一个完整的自定义的控件的例子“'下面放置到一个自定义控件中VERSION 5.00Begin 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 EndEndAttribute VB_Name = "UTextBox"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalseOption 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_ResizeEnd 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) Call PropBag.WriteProperty("Read", ReadOnly, False) Call PropBag.WriteProperty("Enabled", Enabled, True) 'Call PropBag.WriteProperty("MultiLine", MultiLine, False) 'Call PropBag.WriteProperty("ScrollBars", ScrollBars, 0)End Sub
Private Sub uTextBox_Click() RaiseEvent ClickEnd Sub
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 IfEnd 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 IfEnd Sub
Private Sub UserControl_Resize()With UserControl uTextBox.Move .ScaleLeft, .ScaleTop, .ScaleWidth, .ScaleHeightEnd WithEnd Sub
Public Property Let BackColor(ByVal vNewValue As OLE_COLOR) Let m_BackColor = vNewValue Let uTextBox.BackColor = vNewValue Let UserControl.BackColor = vNewValueEnd Property
Public Property Get BackColor() As OLE_COLOR Let BackColor = m_BackColorEnd Property
Public Property Let Text(ByVal vNewValue As String) Let uTextBox.Text = vNewValueEnd Property
Public Property Get Text() As String Let Text = uTextBox.TextEnd Property
Public Property Let Alignment(ByVal vNewValue As VBRUN.AlignmentConstants) Let m_TextAlig = vNewValue Let uTextBox.Alignment = vNewValueEnd Property
Public Property Get Alignment() As VBRUN.AlignmentConstants Let Alignment = m_TextAligEnd Property
Public Property Let ReadOnly(ByVal vNewValue As Boolean) Let m_Read = vNewValue Let uTextBox.Locked = vNewValueEnd Property
Public Property Get ReadOnly() As Boolean Let ReadOnly = m_ReadEnd Property
Private Sub uTextBox_Change() RaiseEvent ChangeEnd Sub
Public Property Set Menu(ByRef vNewValue As Menu) Set m_Menu = vNewValueEnd Property
Public Property Get Menu() As Menu Set Menu = m_MenuEnd Property
Public Property Let MaxLength(ByVal vNewValue As Integer) Let m_MaxLength = vNewValue Let uTextBox.MaxLength = vNewValueEnd Property
Public Property Get MaxLength() As Integer Let MaxLength = m_MaxLengthEnd Property
Public Property Let SelLength(ByVal vNewValue As Integer) 'Let m_SelLength = vNewValue Let uTextBox.SelLength = vNewValueEnd Property
Public Property Get SelLength() As Integer Let SelLength = uTextBox.SelLengthEnd Property
Public Property Let SelStart(ByVal vNewValue As Integer) Let uTextBox.SelStart = vNewValueEnd Property
Public Property Get SelStart() As Integer Let SelStart = uTextBox.SelStartEnd Property
Public Property Let SelText(ByVal vNewValue As String) Let uTextBox.SelText = vNewValueEnd Property
Public Property Get SelText() As String Let SelText = uTextBox.SelTextEnd Property
'Public Property Let MulitLine(ByVal vNewValue As Boolean)' Let uTextBox.MultiLine = vNewValue'End Property
'Public Property Get MultiLine() As Boolean' Let MulitLine = uTextBox.MulitLine'End Property
'Public Property Let ScrollBars(ByVal vNewValue As VBRUN.ScrollBarConstants)' Let uTextBox.ScrollBars = vNewValue'End Property
'Public Property Get ScrollBars() As VBRUN.ScrollBarConstants' Let ScrollBars = uTextBox.ScrollBars'End Property
Public Property Let Enabled(ByVal vNewValue As Boolean) Let m_Enabled = vNewValue Let uTextBox.Enabled = vNewValue Let UserControl.Enabled = vNewValueEnd Property
Public Property Get Enabled() As Boolean Let Enabled = m_EnabledEnd Property
'将前面模块中的代码保留
'新建一个窗体，看现在这个自定义的真正锁定的文本控件如何？
