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
‘/////////////////////////////// 闵峰
‘/////////////////////////////// 闵峰