none
Ayuda UserTextBox RRS feed

  • Pregunta

  • Hola Tengo el siguiente código para crear un textbox

    nota: las fuentes deben ser monospace.

    Imports System.ComponentModel
    Imports System.Text.RegularExpressions
    
    Public Class DrawTextControl
        Inherits Control
    
        'Private Sub initlines()
        '    Lines = Text.Split(New String() {"\r\n"}, System.StringSplitOptions.None)
        'End Sub
    
        Private r As Rectangle
        Private lineInterval As Integer = 1 '3
        Private charWidth As Integer
        Private charHeight As Integer
        '
        Private MoveValue As Integer = 0
        Private cPoint As New Point(0, 0)
        '
        Private m_Start As Integer = 0
        Private m_End As Integer = 0
        Private m_CursorColor As Color = Color.Black
        Private WithEvents mTimer As Timer
        Private iStart As Integer = 0
        Private iEnd As Integer = 0
        Private RSelection As Rectangle
        '
        Private m_ReadyOnly As Boolean = False
        Private m_Text As String
        '
        Private m_IsBorder As Boolean = True
        Private m_BorderColor As Color = Color.FromArgb(127, 157, 185)
        Public Sub New()
            ' Agregue cualquier inicialización después de la llamada a InitializeComponent().
            SetStyle(ControlStyles.AllPaintingInWmPaint Or _
                     ControlStyles.OptimizedDoubleBuffer Or _
                     ControlStyles.ResizeRedraw Or _
                     ControlStyles.SupportsTransparentBackColor Or _
                     ControlStyles.UserPaint, True)
            Me.DoubleBuffered = True
            '
            Configure()
        End Sub
    
        Private Sub Configure()
            mTimer = New Timer
            mTimer.Interval = 1
            mTimer.Enabled = True
            '
            Me.Cursor = Cursors.IBeam
            Me.BackColor = Color.White
            Me.Size = New Size(100, 20)
            Me.Font = New Font(FontFamily.GenericMonospace, 9.75F)
            '
            Dim p1 As New Point(lineInterval, lineInterval)
            Dim p2 As New Point(Me.Width - 1, Me.Height - 1)
            r = New Rectangle(p1, p2)
            '
            RSelection = New Rectangle((cPoint.X + lineInterval) + 1, lineInterval + 2, 0, charHeight - 1)
        End Sub
    
    #Region "Mehodes Font ======================================================================"
    
        Private Sub setFont(ByVal Font As Font)
            Dim sizeM As SizeF = GetCharSize(Me.Font, "M")
            Dim sizeDot As SizeF = GetCharSize(Me.Font, ".")
            If sizeM <> sizeDot Then
                Me.Font = New Font("Courier New", Me.Font.SizeInPoints, FontStyle.Regular, GraphicsUnit.Point)
            End If
            '
            ' clac size
            Dim size As SizeF = GetCharSize(Me.Font, "M")
            charWidth = Math.Round(size.Width * 1.0F) - 1
            charHeight = lineInterval + Math.Round(size.Height * 1.0F) - 1
        End Sub
    
        Public Function GetCharSize(ByVal font As Font, ByVal c As String) As SizeF
            Dim sz2 As Size = TextRenderer.MeasureText("<" + c.ToString() + ">", font)
            Dim sz3 As Size = TextRenderer.MeasureText("<>", font)
    
            Return New SizeF(sz2.Width - sz3.Width + 1, font.Height)
        End Function
    
    #End Region
    
    #Region "Control Propertys ======================================================================"
    
        Public Overrides Property Text As String
            Get
                Return m_Text
            End Get
            Set(ByVal value As String)
                m_Text = value
                '
                Me.Invalidate()
            End Set
        End Property
    
        <DefaultValue(GetType(Font), "Courier New, 9.75")> _
        Public Overrides Property Font As System.Drawing.Font
            Get
                Return MyBase.Font
            End Get
            Set(value As System.Drawing.Font)
                MyBase.Font = value
                '
                setFont(value.Clone)
                '
                Me.Invalidate()
            End Set
        End Property
    
        Public Property Border As Boolean
            Get
                Return m_IsBorder
            End Get
            Set(value As Boolean)
                m_IsBorder = value
                '
                Me.Invalidate()
            End Set
        End Property
    
        Public Property BorderColor As Color
            Get
                Return m_BorderColor
            End Get
            Set(value As Color)
                m_BorderColor = value
                '
                Me.Invalidate()
            End Set
        End Property
    
        Public Property CursorColor As Color
            Get
                Return m_CursorColor
            End Get
            Set(value As Color)
                m_CursorColor = value
                '
                Me.Invalidate()
            End Set
        End Property
    
    #End Region
    
    #Region "Eventos del Control ======================================================================"
    
        Protected Overrides Sub OnGotFocus(e As System.EventArgs)
            Me.Invalidate()
            Aument = 0
            IsCursor = True
            mTimer.Enabled = True
            MyBase.OnGotFocus(e)
        End Sub
    
        Protected Overrides Sub OnLostFocus(e As System.EventArgs)
            Me.Invalidate()
            IsCursor = False
            mTimer.Enabled = False
            MyBase.OnLostFocus(e)
        End Sub
    
        Private IsMouseDown As Boolean = False
        Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs)
            Me.Focus()
            '
            If e.Button = Windows.Forms.MouseButtons.Left Then
                IsMouseDown = True
                m_Start = 0
                m_End = 0
                RSelection.Width = 0
                '
                CursorMovePost(e)
                '
                m_End = 0
                m_Start = (cPoint.X + lineInterval) + 1
                '
                iStart = Math.Max(1, Math.Truncate(cPoint.X / charWidth) + 1)
            End If
            '
            MyBase.OnMouseDown(e)
        End Sub
    
        Protected Overrides Sub OnMouseUp(e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseUp(e)
            '
            IsMouseDown = False
        End Sub
    
        Protected Overrides Sub OnMouseDoubleClick(e As System.Windows.Forms.MouseEventArgs)
            MyBase.OnMouseDoubleClick(e)
            '
            If e.Button = Windows.Forms.MouseButtons.Left Then
                Me.SelectionAll()
            End If
        End Sub
    
        Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
            If IsMouseDown = True Then
                CursorMovePost(e)
                m_End = (cPoint.X + lineInterval) + 1
                iEnd = (RSelection.Width / charWidth)
                '
                If (m_Start < m_End) Then
                    RSelection.X = m_Start
                    RSelection.Width = m_End - m_Start
                    '
                    iStart = Math.Max(1, Math.Truncate(m_Start / charWidth) + 1)
                    iEnd = (RSelection.Width / charWidth)
                Else
                    RSelection.X = m_End
                    RSelection.Width = m_Start - m_End
                    '
                    iStart = Math.Max(1, Math.Truncate(m_End / charWidth) + 1)
                    iEnd = (RSelection.Width / charWidth)
                End If
                '
                'iEnd = (RSelection.Width / charWidth)
            End If
            '
            MyBase.OnMouseMove(e)
        End Sub
    
        Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
            MyBase.OnPaint(e)
            '
            DrawSelection(e)
            '
            Dim p1 As New Point(lineInterval, (Me.Height / 2) - (charHeight / 2))
            Dim p2 As New Point(Me.Width - 1, Me.Height - 1)
            r = New Rectangle(p1, p2)
            '
            e.Graphics.DrawString(m_Text, Me.Font, New SolidBrush(Me.ForeColor), p1)
            '
            DrawBorder(e)
            '
            If DesignMode = False Then
                DrawCursor(e)
            End If
        End Sub
    
        Protected Overrides Function IsInputKey(keyData As System.Windows.Forms.Keys) As Boolean
            Return True 'MyBase.IsInputKey(keyData)
        End Function
    
        Protected Overrides Sub OnKeyDown(e As System.Windows.Forms.KeyEventArgs)
            Aument = 0
            IsCursor = False
            '
            Select Case e.KeyCode
                Case Keys.Delete
                    DeleteBackChar()
                Case Keys.Back
                    DeleteNexChar()
                Case Keys.Left
                    MoveLeft()
                Case Keys.Right
                    MoveRight()
            End Select
            '
            MyBase.OnKeyDown(e)
        End Sub
    
        Protected Overrides Sub OnKeyPress(e As System.Windows.Forms.KeyPressEventArgs)
            If m_ReadyOnly = True Then
                Return
            End If
            '
            If Not Char.IsControl(e.KeyChar) Then
                Me.m_Text = Mid(Me.m_Text, 1, MoveValue) & e.KeyChar & Mid(Me.m_Text, MoveValue + 1, Me.m_Text.Length)
                '
                Dim auxText As String = Mid(Text, 1, MoveValue) & e.KeyChar
                cPoint = New Point(GetCharSize(Me.Font, auxText).Width, 0)
                MoveValue = auxText.Length
                '
                m_Start = 0
                m_End = 0
                RSelection.Width = 0
            End If
            '
            MyBase.OnKeyPress(e)
        End Sub
    
    #End Region
    
        ' Coloca el mouse en la posicion corespondiente.
        Public Sub CursorMovePost(ByVal e As System.Windows.Forms.MouseEventArgs)
            Aument = 0
            IsCursor = False
            '
            Dim mpx As Integer = Math.Max(lineInterval, e.X)
            Dim mX As Integer = Math.Truncate(mpx / charWidth)
            Dim px As Double = (mX * charWidth) '+ lineInterval
            If e.Button = Windows.Forms.MouseButtons.Left Then
                Dim SizeTextAll As Integer = GetCharSize(Me.Font, RemoveNextChar(mX)).Width
                cPoint = New Point(SizeTextAll, 0)
                MoveValue = (SizeTextAll / charWidth)
                '
                Me.Invalidate()
            End If
        End Sub
    
        ' Mueve el carete hacia la izquierda.
        Private Sub MoveLeft()
            Aument = 0
            IsCursor = False
            '
            MoveValue -= 1
            If MoveValue < 0 Then
                MoveValue = 0
            End If
            '
            'cPoint = New Point((RemoveNextChar(MoveValue).Length * charWidth) + 1, 0)
            '
            cPoint = New Point(GetCharSize(Me.Font, RemoveNextChar(MoveValue)).Width, 0)
        End Sub
    
        ' Mueve el carete hacia la derecha.
        Private Sub MoveRight()
            Aument = 0
            IsCursor = False
            '
            MoveValue += 1
            If MoveValue > Text.Length Then
                MoveValue = Text.Length
            End If
            '
            'cPoint = New Point((RemoveNextChar(MoveValue).Length * charWidth) + 1, 0)
            '
            cPoint = New Point(GetCharSize(Me.Font, RemoveNextChar(MoveValue)).Width, 0)
        End Sub
    
        ' Corta el texto en la posicion indicada.
        Private Function RemoveNextChar(ByVal renValue As Integer) As String
            Return Mid(m_Text, 1, renValue)
        End Function
    
        ' Remueve el caracter que esta delante.
        Private Sub DeleteNexChar()
            If MoveValue <= 0 Then Exit Sub
            MoveLeft()
            Text = Mid(Text, 1, MoveValue) & Mid(Text, MoveValue + 2, Text.Length)
        End Sub
    
        ' Remueve el caracter que esta detras.
        Private Sub DeleteBackChar()
            If MoveValue >= Text.Length Then Exit Sub
            Text = Mid(Text, 1, MoveValue) & Mid(Text, MoveValue + 2, Text.Length)
        End Sub
    
        Private Sub SelectionClearRect()
            RSelection.X = 0
            RSelection.Width = 0
        End Sub
    
    #Region "Methodes Text ======================================================================"
    
        Public Sub Cut()
            ' Function para cortar.
        End Sub
    
        ' Function para copiar.
        Public Sub Copy()
            If iStart > 0 And iEnd > 0 And Me.m_Text <> "" Then
                Dim msText As String = Mid(m_Text, iStart, iEnd)
                If msText <> "" Then
                    My.Computer.Clipboard.SetText(msText)
                End If
            End If
        End Sub
    
        ' Function para pegar. Tiene un error.
        Public Sub Paste()
            Dim SizeTextAll As Integer = 0
            Dim PText As String = My.Computer.Clipboard.GetText()
            Dim mstext As String = ""
            Dim mstext2 As String = ""
            If iStart > 0 And iEnd > 0 And PText <> "" Then
                mstext = Mid(m_Text, iStart, iEnd)
                mstext2 = m_Text.Replace(mstext, PText)
                '
                Me.m_Text = mstext2
            Else
                Me.m_Text = Mid(Me.m_Text, 1, MoveValue) & PText & _
                Mid(Me.m_Text, Math.Max(1, MoveValue), Me.m_Text.Length)
            End If
            '
            SizeTextAll = GetCharSize(Me.Font, RemoveNextChar((iStart + PText.Length))).Width
            cPoint = New Point(SizeTextAll, 0)
            MoveValue = (SizeTextAll / charWidth)
            '
            SelectionClearRect()
            '
            Me.Invalidate()
        End Sub
    
        ' Function para la seleccion total.
        Public Sub SelectionAll()
            Dim SizeTextAll As Integer = GetCharSize(Me.Font, RemoveNextChar(m_Text.Length)).Width
            RSelection.X = (lineInterval) + 2
            RSelection.Width = SizeTextAll
            '
            cPoint = New Point(SizeTextAll, 0)
            MoveValue = (SizeTextAll / charWidth)
            '
            iStart = Math.Max(1, Math.Truncate(RSelection.X / charWidth) + 1)
            iEnd = (RSelection.Width / charWidth)
            '
            Me.Invalidate()
        End Sub
    
    #End Region
    
    #Region "Draw Methodes ======================================================================"
    
        ' Dibuja el border del control.
        Private Sub DrawBorder(ByVal e As PaintEventArgs)
            If m_IsBorder = True Then
                Dim r As New Rectangle(0, 0, Me.Width - 1, Me.Height - 1)
                e.Graphics.DrawRectangle(New Pen(New SolidBrush(m_BorderColor)), r)
            End If
        End Sub
    
        ' Dibuja el cursor.
        Private Sub DrawCursor(ByVal e As PaintEventArgs)
            If IsCursor And Me.Focused Then
                Dim p1 As New Point((cPoint.X + lineInterval) + 1, (lineInterval) + 2)
                Dim p2 As New Point(p1.X, charHeight - (lineInterval - 1))
                e.Graphics.DrawLine(New Pen(New SolidBrush(m_CursorColor)), p1, p2)
            End If
        End Sub
    
        Private Sub DrawSelection(ByVal e As PaintEventArgs)
            e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(173, 214, 255)), _
                RSelection.X + lineInterval, RSelection.Y, RSelection.Width - lineInterval, RSelection.Height)
        End Sub
    
        Private IsCursor As Boolean = True
        Private Aument As Integer = 0
        Private AumentSpeed As Double = 8
        Private Sub mTimer_Tick(sender As Object, e As System.EventArgs) Handles mTimer.Tick
            If IsCursor = True Then
                Aument += AumentSpeed
                If Aument >= 255 Then
                    IsCursor = False
                    Me.Invalidate()
                End If
            ElseIf IsCursor = False Then
                Aument -= AumentSpeed
                If Aument <= 0 Then
                    IsCursor = True
                    Me.Invalidate()
                End If
            End If
        End Sub
    
    #End Region
    
    End Class
    

    todo funciona bien, pero cuando cambio el tamaño de la fuente el control funciona incorrectamente, ademas si el texto es muy grande pasa lo mismo.

    el método que uso para saber la posición del cursor es:

    Dim mpx As Integer = Math.Max(lineInterval, e.X)
            Dim mX As Integer = Math.Truncate(mpx / charWidth)
            Dim px As Double = (mX * charWidth) '+ lineInterval
            If e.Button = Windows.Forms.MouseButtons.Left Then
                Dim SizeTextAll As Integer = GetCharSize(Me.Font, RemoveNextChar(mX)).Width
                cPoint = New Point(SizeTextAll, 0)
                MoveValue = (SizeTextAll / charWidth)
                '
                Me.Invalidate()
            End If

    como decía anterior mente to me funciona bien, menos (la posición del cursor/moverme entre las letras, etc) pero solo si cambio la fuente y el texto es mas grande al que ya tiene escrito.

    nota: el problema es que el cursor no se posiciona a la perfección con el tamaño de los caracteres.

    espero poder darme a entender.

    gracias y un saludo desde (Rempublica Dominicana).

    • Cambiado Enrique M. Montejo martes, 11 de febrero de 2014 8:38 Controles de Windows Forms
    viernes, 7 de febrero de 2014 23:05