在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)
    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 Click
End 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 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

Private Sub UserControl_Resize()
With UserControl
    uTextBox.Move .ScaleLeft, .ScaleTop, .ScaleWidth, .ScaleHeight
End With
End Sub

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
    Let m_BackColor = vNewValue
    Let uTextBox.BackColor = vNewValue
    Let UserControl.BackColor = vNewValue
End Property

Public Property Get BackColor() As OLE_COLOR
    Let BackColor = m_BackColor
End Property

Public Property Let Text(ByVal vNewValue As String)
    Let uTextBox.Text = vNewValue
End Property

Public Property Get Text() As String
    Let Text = uTextBox.Text
End Property

Public Property Let Alignment(ByVal vNewValue As VBRUN.AlignmentConstants)
    Let m_TextAlig = vNewValue
    Let uTextBox.Alignment = vNewValue
End Property

Public Property Get Alignment() As VBRUN.AlignmentConstants
    Let Alignment = m_TextAlig
End Property

Public Property Let ReadOnly(ByVal vNewValue As Boolean)
    Let m_Read = vNewValue
    Let uTextBox.Locked = vNewValue
End Property

Public Property Get ReadOnly() As Boolean
    Let ReadOnly = m_Read
End Property

Private Sub uTextBox_Change()
    RaiseEvent Change
End Sub

Public Property Set Menu(ByRef vNewValue As Menu)
    Set m_Menu = vNewValue
End Property

Public Property Get Menu() As Menu
    Set Menu = m_Menu
End Property

Public Property Let MaxLength(ByVal vNewValue As Integer)
    Let m_MaxLength = vNewValue
    Let uTextBox.MaxLength = vNewValue
End Property

Public Property Get MaxLength() As Integer
    Let MaxLength = m_MaxLength
End Property

Public Property Let SelLength(ByVal vNewValue As Integer)
    'Let m_SelLength = vNewValue
    Let uTextBox.SelLength = vNewValue
End Property

Public Property Get SelLength() As Integer
    Let SelLength = uTextBox.SelLength
End Property

Public Property Let SelStart(ByVal vNewValue As Integer)
    Let uTextBox.SelStart = vNewValue
End Property

Public Property Get SelStart() As Integer
    Let SelStart = uTextBox.SelStart
End Property

Public Property Let SelText(ByVal vNewValue As String)
    Let uTextBox.SelText = vNewValue
End Property

Public Property Get SelText() As String
    Let SelText = uTextBox.SelText
End 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 = vNewValue
End Property

Public Property Get Enabled() As Boolean
    Let Enabled = m_Enabled
End Property

'將前面模塊中的代碼保留

'新建一個窗體，看現在這個自定義的真正鎖定的文本控件如何？