Command-defined menu text controls in VB
///// The introduction of this thing is due to a netizen's post, too gas, I wrote, very hurried, what is the problem, please point out! Thank you //qq:9181729/mail :shawfile@163.net/http://shawls.yeah.net///
The TextBox control in VB, although the locked property can be set to lock the text, but if the user uses the right-click menu, then it doesn't work, can still edit the text, is there a way to make the user can't make the text box Edit and replace the right-click menu of the control?
Complete implementation code as follows: 'Core code code' utextbox is the text control M_Menu you want to mask M_Menu is the menu M_Read tag that you want to populate, whether you want to lock 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) 'to obtain the address of the window function Call SetWindowLong (uTextBox.hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage)' SubClass_WndMessage replaced by the window function process message 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) 'function to restore the default window Eject Custom Menu if not m_menu is nothing the if typeof m_Menu is menu ten PopUpMenu M_Menu End if end if end ifend sub
'Is it placed in the module?
Public Declare Function CallWindowProc LIB "User32" Alias "CallWindowProca" (Byval Hwndfunc As Long, Byval Hwnd As Long, Byval Msg As Long, Byval WParam As Long) As long
Public Declare Function SetWindowlong Lib "User32" Alias "SetWindowlonga" (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) 'If the message is not WM_CONTEXTMENU, to call the default window function processing Exit function End If SubClass_WndMessage = TrueEnd function 'is an example of what a complete custom control "' to be placed under a custom control 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 = Falsettribute vb_creatable = truettribute vb_predeclaredId = falsettribute vb_exposed = falseopt Ion expllicit
Private m_BackColor As OLE_COLOR 'color Private m_MaxLength As Integer' length Private m_TextAlig As VBRUN.AlignmentConstants' text position Private m_Menu As Menu 'custom menu Private m_Read As Boolean' is readable Private m_Enabled As Boolean 'Enabled'Private m_MulitLine As Boolean' wrap Private const m_defbackcolor = & h80000018 'Default text background color public event change ()' Text Modify Event Public Event Click () 'Click event
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 SubPrivate 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) 'to obtain the address of the window function Call SetWindowLong (uTextBox. hWnd, GWL_WNDPROC, AddressOf SubClass_WndMessage) 'treated with SubClass_WndMessage instead of a window function message End IfEnd SubPrivate 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) 'Recovery Window Default Function' Bounce Custom Menu if Not M_Menu Is Nothing IF TypeOf M_Menu Is Menu Then PopUpMenu M_Menu End If End Ifund Sub
Private sub usercontrol_resize () with usercontrol utextbox.move .scaleleft, .scaletop, .scalewidth, .scaleheightend welhend 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 PropertyPublic 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 Leet M_MaxLength = VNewValue Let UtextBox.maxlength = VNewValueEnd Property
Public Property Get Maxlength () AS Integer Let Maxlength = M_MaxLengthThend Property
Public property let sellength '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'ENend Property
'Public Property Let Scrollbars (Byval VNewValue As VBRun.scrollbarconstants)' let utextbox.scrollbars = VNewValue'ENend Property
'Public Property Get ScrollBars () As VBRUN.ScrollBarConstants' Let ScrollBars = uTextBox.ScrollBars'End PropertyPublic 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 print
'Reserve the code in the previous module
'Newly built a form to see how this custom really locked text control is?
