Partial Public NotInheritable Class NumericUpDownEx Inherits NumericUpDown
Private Sub CaretPosChanged(sender As Object, e As EventArgs)
End Sub
Private WithEvents upDownEdit As TextBoxBase Private caretPos As Integer = -1 Public Sub New() MyBase.New() upDownEdit = Controls.OfType(Of TextBoxBase)().Single() AddHandler Application.Idle, AddressOf Application_Idle End Sub Private Sub Application_Idle(sender As Object, e As EventArgs) If upDownEdit.SelectionStart <> caretPos OrElse upDownEdit.SelectionStart = 0 Then caretPos = upDownEdit.SelectionStart Try If caretPos = 0 AndAlso upDownEdit.TextLength > 0 Then upDownEdit.Select(upDownEdit.SelectionStart + 1, Math.Max(0, upDownEdit.SelectionLength - 1)) caretPos = upDownEdit.SelectionStart End If Catch Finally CaretPosChanged(Me, EventArgs.Empty) End Try End If End Sub End Class
Inherits NumericUpDown Protected Overrides Sub UpdateEditText() Dim upDownEdit = Controls.OfType(Of TextBoxBase)().Single() Dim pos = upDownEdit.SelectionStart MyBase.UpdateEditText() upDownEdit.SelectionStart = pos End Sub
Option Strict On Imports System.Text.RegularExpressions Partial Public NotInheritable Class NumericUpDownEx Inherits NumericUpDown Protected Overrides Sub UpdateEditText() Dim upDownEdit = Controls.OfType(Of TextBoxBase)().Single() Dim pos = upDownEdit.SelectionStart MyBase.UpdateEditText() upDownEdit.SelectionStart = pos Increment = ProposeIncrementValue(pos) End Sub
Protected Overrides Sub OnTextBoxKeyDown(source As Object, e As KeyEventArgs) Dim c = DirectCast(source, TextBoxBase) Increment = ProposeIncrementValue(c.SelectionStart) MyBase.OnTextBoxKeyDown(source, e) Increment = ProposeIncrementValue(c.SelectionStart) End Sub
Protected Overrides Sub OnMouseClick(e As MouseEventArgs) Dim c = Controls.OfType(Of TextBoxBase)().Single() Increment = ProposeIncrementValue(c.SelectionStart) MyBase.OnMouseClick(e) Increment = ProposeIncrementValue(c.SelectionStart) End Sub
Private Function ProposeIncrementValue(pos As Integer) As Decimal '0.00〜999.99 の範囲を前提とした手抜き実装 Dim m = Regex.Match(Text, "(?<Left>\d+)\.(?<Right>\d+)") If Not m.Success Then Return 0D Else Dim L = m.Groups("Left").Value 'Dim R = m.Groups("Right").Value If L.Length + 3 = pos Then Return 0.01D ElseIf L.Length < pos Then Return 0.1D ElseIf L.Length = 3 Then If pos <= 1 Then Return 100D ElseIf pos = 2 Then Return 10D Else Return 1D End If ElseIf L.Length = 2 Then If pos <= 1 Then Return 10D Else Return 1D End If ElseIf L.Length <= 1 Then Return 1D Else Return 0D End If End If End Function End Class