Imports System.Text
Public Class mytextbox
Inherits System.Windows.Forms.TextBox
Dim WithEvents btn As Button
Dim WithEvents btn As Button
Public Sub New()
MyBase.New()
'该调用是 Windows 窗体设计器所必需的。
'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()
'在 InitializeComponent() 调用之后添加任何初始化
'在 InitializeComponent() 调用之后添加任何初始化
btn = New Button()
btn.Size = New Size(23, 23)
Me.Controls.Add(btn)
btn.Dock = DockStyle.Right
btn.BackColor = SystemColors.Control
Me.Text = ""
End Sub
Public Event myclick(ByVal sender As Object, ByVal e As EventArgs)
Public Event myclick(ByVal sender As Object, ByVal e As EventArgs)
Private Sub btn_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btn.Click
RaiseEvent myclick(Me, e)
End Sub
Private Sub btn_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles btn.MouseEnter
Private Sub btn_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles btn.MouseEnter
Cursor = Cursors.Default
End Sub
Private Sub btn_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles btn.MouseLeave
Private Sub btn_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles btn.MouseLeave
Cursor = Cursors.IBeam
End Sub
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Dim KeyAsc As Integer = m.WParam.ToInt32
Select Case m.Msg
Case &H102
If checklength() Then
If KeyAsc <> 8 Then
Return
End If
Else
Me.MaxLength = 0
End If
Case &H302
If checklength() Then
Return
End If
End Select
MyBase.WndProc(m)
End Sub
'检查函数
Private Function checklength(Optional ByVal str As String = "") As Boolean
If str = "" Then
Dim leng As Integer = CInt(Me.CreateGraphics.MeasureString(Me.Text, Me.Font).Width)
Dim m As Integer = Me.Width
Dim p As Integer = btn.Width
If leng >= m - p - 5 Then
Return True
End If
Else
Dim leng As Integer = CInt(Me.CreateGraphics.MeasureString(str, Me.Font).Width)
Dim m As Integer = Me.Width
Dim p As Integer = btn.Width
If leng + 1 >= m - p Then
Return True
End If
End If
Return False
End Function
'修改text属性时检查
Public Overrides Property Text() As String
Get
Return MyBase.Text
End Get
Set(ByVal Value As String)
If checklength(Value) Then
Throw New Exception("超出可以显示的范围！")
End If
MyBase.Text = Value
End Set
End Property
End Class
End Class
‘/////////////////////////////// 闵峰
‘/////////////////////////////// 闵峰