Ayuda, buscar y resaltar la palabras de un RichTextBox

Iniciado por **Aincrad**, 26 Noviembre 2017, 20:30 PM

0 Miembros y 2 Visitantes están viendo este tema.

**Aincrad**

bueno como dice el titulo quiero buscar y resaltar una palabra de un RichTextBox1.


este método solo marca la 1era palabra encontrada. y las otras palabras que son las mismas no la subraya.

ejemplo le digo que busque todas las palabras hola , pero solo me marca la primera encontrada y las demás no mas marca.


Código (vbnet) [Seleccionar]
Dim Search, Where

        Search = TextBox1.Text
        Where = InStr(RichTextBox1.Text, Search)
        Dim n As Integer
        If Where Then
            Name = n + 1
            RichTextBox1.Focus()
            RichTextBox1.SelectionStart = Where - 1
            RichTextBox1.SelectionLength = Len(Search)
        Else
            MsgBox("String not found.")
        End If


Gracias de antemano.




Eleкtro

#1
Basicamente a tu código le falta usar la función RichTextBox.Find() junto a un búcle para ir iterando las posiciones de las ocurrencias encontradas en el texto. Lo que has intentado hacer recurriendo al uso de funciones de VB6 como InStr... ese no es el camino en .NET, debes evitar toda esa morralla (basura) de miembros de VB6, ya que son miembros que están ahí solo por compatibilidad, aunque estén escritos en código .NET son miembros cuyo código fuente es muy poco óptimo y limitado, todo esto ya te lo comenté en el pasado pero sigues sin hacer caso del consejo. :-/

Una solucoón que considero sencilla de aplicar para cualquier nivel de aprendizaje, podría ser la siguiente, a modo de función de uso genérico reutilizable para cualquier tipo de ocasión...

Código (vbnet) [Seleccionar]
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Find all the occurrences of the specified strings in the source <see cref="RichTextBox"/>
''' and set the foreground color, background color, and the font of any occurrence found.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="rtb">
''' The source <see cref="RichTextBox"/>.
''' </param>
'''
''' <param name="find">
''' An Array containing the strings to match.
''' </param>
'''
''' <param name="ignoreCase">
''' Specifies how a text search is carried out.
''' </param>
'''
''' <param name="foreColor">
''' The foreground color to set for the matched strings.
''' </param>
'''
''' <param name="backColor">
''' The background color to set for the matched strings.
''' </param>
'''
''' <param name="font">
''' The font to set for the matched strings.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' Returns the total amount of occurrences found.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function InternalColorizeMatches(ByVal rtb As RichTextBox,
                                              ByVal find As String,
                                              ByVal ignoreCase As Boolean,
                                              ByVal foreColor As Color,
                                              ByVal backColor As Color,
                                              ByVal font As Font) As Integer

   If String.IsNullOrEmpty(find) Then
       Return 0
   End If

   ' Set letter-case criteria.
   Dim richTextBoxFinds As RichTextBoxFinds =
       If(ignoreCase, RichTextBoxFinds.None, RichTextBoxFinds.MatchCase)
   Dim stringComparison As StringComparison =
       If(ignoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)

   ' Save the current caret position to restore it at the end.
   Dim caretPosition As Integer = rtb.SelectionStart

   Dim successCount As Integer = 0
   Dim textLength As Integer = rtb.TextLength
   Dim firstIndex As Integer = 0
   Dim lastIndex As Integer = rtb.Text.LastIndexOf(find, stringComparison)

   While (firstIndex <= lastIndex)
       Dim findIndex As Integer = rtb.Find(find, firstIndex, textLength, richTextBoxFinds)
       If (findIndex <> -1) Then
           successCount += 1
       Else
           Continue While
       End If

       rtb.SelectionColor = foreColor
       rtb.SelectionBackColor = backColor
       rtb.SelectionFont = font

       firstIndex = (rtb.Text.IndexOf(find, findIndex, stringComparison) + 1)
   End While ' (firstIndex <= lastIndex)

   ' Restore the caret position. Reset selection length to zero.
   rtb.Select(caretPosition, length:=0)

   Return successCount

End Function





Ese código de arriba resolvería el problema, con eso ya está, así que si lo prefieres puedes no seguir leyendo nada más de este comentario, pero si quieres aprender cosas nuevas entonces sigue leyendo...

...Para implementar las funcionalidades de búsqueda y resaltado de palabras, para hacerlo decentemente quiero decir, lo más apropiado sería empezar por bloquear temporálmente los mensajes de ventana de dibujado de la ventana del control afectado para optimizar (acelerar) el procedimiento de ejecución, y de paso al mismo tiempo intentar evitar indiseados efectos de flickering.

Bueno, ya que lo has intentado hacer por ti mismo, te voy a mostrar un ejemplo completo y funcional. Para hacerlo funcionar simplemente debes copia y pegar cada bloque de código que iré mostrando, en una nueva clase por cada bloque de código (pero no seas vago, lee algo del código para intentar aprender buenos hábitos de programación .NET). Si no entiendes algo, pregúntalo.

Debido al límite de caracteres del foro, me he visto obligado a recortar mucho código para eliminar practicamente casi toda la documentación XML...

Sin embargo, para hacerlo todo más facil y comprensible, abajo del todo de esta respuesta te dejo un proyecto hecho en Visual Studio 2017 con el código y su documentación al completo y que además contiene esta pequeña aplicación para demostrar la funcionalidad de búsqueda y resaltado de palabras:



También cabe mencionar que el código fuente de aquí abajo solo provee la funcionalidad de "Buscar todas las ocurrencias", pero no provee la funcionalidad de "Buscar siguiente palabra" hacia arriba/abajo etc, aunque si que tengo implementadas ese tipo de funciones en mi librería comercial... pero tampoco voy a regalarlo todo hecho, así que me limito a resolver la duda en concreto de "¿cómo buscar y colorear todas las ocurrencias de un string?".




NOTA INFORMATIVA:
---
EL SIGUIENTE CÓDIGO HA SIDO EXTRAIDO Y OFRECIDO DE FORMA GRATUITA A PARTIR DE MI FRAMEWORK COMERCIAL ELEKTROKIT FRAMEWORK , EL CUAL CONTIENE UNA INFINIDAD DE UTILIDADES ENFOCADAS A UNA AMPLIA VARIEDAD DE TEMÁTICAS Y ESCENARIOS EN LA PROGRAMACIÓN .NET, COMO ÉSTE. SI QUIEREN CONOCER MÁS ACERCA DEL PRODUCTO, PUEDEN ENCONTRARLO EN MI FIRMA DE USUARIO DEL FORO.
ESTE CÓDIGO SE PUEDE USAR Y MODIFICAR DE FORMA LIBRE COMO LES APETEZCA.

---





WindowsMessages.vb

Código (vbnet) [Seleccionar]
#Region " Windows Messages "

Namespace ElektroKit.Interop.Win32

   ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx
   Friend Enum WindowsMessages As Integer
       ' http://msdn.microsoft.com/en-us/library/windows/desktop/dd145219%28v=vs.85%29.aspx
       WM_SetRedraw = &HB
   End Enum

End Namespace

#End Region





RedrawWindowFlags.vb

Código (vbnet) [Seleccionar]
#Region " RedrawWindowFlags "

Namespace ElektroKit.Interop.Win32

   ' http://msdn.microsoft.com/en-us/library/windows/desktop/dd162911%28v=vs.85%29.aspx
   <Flags>
   Friend Enum RedrawWindowFlags As Integer
       Invalidate = &H1
       InternalPaint = &H2
       [Erase] = &H4
       Validate = &H8
       NoInternalPaint = &H10
       NoErase = &H20
       NoChildren = &H40
       AllChildren = &H80
       UpdateNow = &H100
       EraseNow = &H200
       Frame = &H400
       NoFrame = &H800
   End Enum

End Namespace

#End Region





NativeMethods.vb

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.ComponentModel
Imports System.Diagnostics
Imports System.Runtime.InteropServices
Imports System.Security

#End Region

#Region " NativeMethods "

Namespace ElektroKit.Interop.Win32

   ' http://msdn.microsoft.com/en-us/library/ms182161.aspx
   Friend NotInheritable Class NativeMethods ' NOT <SuppressUnmanagedCodeSecurity>

#Region " Constructors "

       <DebuggerNonUserCode>
       Private Sub New()
       End Sub

#End Region

#Region " User32.dll "

       ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644950%28v=vs.85%29.aspx
       <DllImport("User32.dll", SetLastError:=True)>
       Friend Shared Function SendMessage(ByVal hwnd As IntPtr,
                                          ByVal msg As Integer,
                                          ByVal wParam As IntPtr,
                                          ByVal lParam As IntPtr
       ) As IntPtr
       End Function

       ' http://msdn.microsoft.com/en-us/library/windows/desktop/dd162911%28v=vs.85%29.aspx
       <DllImport("User32.dll")>
       Friend Shared Function RedrawWindow(ByVal hwnd As IntPtr,
                                           ByVal lprcUpdate As IntPtr,
                                           ByVal hrgnUpdate As IntPtr,
                                           ByVal flags As RedrawWindowFlags
       ) As <MarshalAs(UnmanagedType.Bool)> Boolean
       End Function

#End Region

   End Class

End Namespace

#End Region





IWin32Window_Extensions.vb

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.ComponentModel
Imports System.Diagnostics
Imports System.Drawing
Imports System.Runtime.CompilerServices

Imports ElektroKit.Interop.Win32

Imports WinForms = System.Windows.Forms

#End Region

#Region " IWin32Window Extensions "

Namespace ElektroKit.Extensions.[IWin32Window]

   ''' <summary>
   ''' Provides custom extension methods to use with <see cref="WinForms.IWin32Window"/> type.
   ''' </summary>
   <HideModuleName>
   Public Module Drawing

#Region " Public Extension Methods "

       ''' <summary>
       ''' Prevents the specified window from being redrawn.
       ''' <para></para>
       ''' By calling this method, it will disallow painting events from firing on the specified window.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Sub SuspendDrawing(ByVal sender As WinForms.IWin32Window)
           NativeMethods.SendMessage(sender.Handle, WindowsMessages.WM_SetRedraw, IntPtr.Zero, IntPtr.Zero)
       End Sub

       ''' <summary>
       ''' Allow the specified window to be redrawn.
       ''' <para></para>
       ''' By calling this method, it will allow painting events to be fired on the specified window.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Sub ResumeDrawing(ByVal sender As WinForms.IWin32Window)
           Drawing.ResumeDrawing(sender, True)
       End Sub

       ''' <summary>
       ''' Allow the specified window to be redrawn.
       ''' <para></para>
       ''' By calling this method, it will allow painting events to be fired on the specified window.
       ''' </summary>
       ''' <param name="redraw">
       ''' If set to <see langword="True"/>, causes the window to de redrawn
       ''' (similarly as calling <see cref="WinForms.Control.Refresh()"/> method).
       ''' </param>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Sub ResumeDrawing(ByVal sender As WinForms.IWin32Window, ByVal redraw As Boolean)
           NativeMethods.SendMessage(sender.Handle, WindowsMessages.WM_SetRedraw, New IntPtr(1), IntPtr.Zero)
           If (redraw) Then
               NativeMethods.RedrawWindow(sender.Handle, IntPtr.Zero, IntPtr.Zero,
                                          RedrawWindowFlags.Frame Or
                                          RedrawWindowFlags.UpdateNow Or
                                          RedrawWindowFlags.Invalidate)
           End If
       End Sub

#End Region

   End Module

End Namespace

#End Region





RichTextBox_Extensions.vb

Código (vbnet) [Seleccionar]
#Region " Imports "

Imports System.ComponentModel
Imports System.Drawing
Imports System.Runtime.CompilerServices
Imports System.Text.RegularExpressions

Imports WinForms = System.Windows.Forms

#End Region

#Region " RichTextBox Extensions "

Namespace ElektroKit.Extensions.[RichTextBox]

   ''' <summary>
   ''' Provides custom extension methods to use with <see cref="WinForms.RichTextBox"/> control.
   ''' </summary>
   <HideModuleName>
   Public Module WordFinding

#Region " Public Extension Methods "

#Region " Strings "

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String, ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, ignoreCase, foreColor, Nothing, Nothing)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String, ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, ignoreCase, foreColor, backColor, Nothing)

       End Function

       ''' <summary>
       ''' Matches all the occurrences of the specified string in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String, ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color,
                                       ByVal font As Font) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, ignoreCase, foreColor, backColor, font)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String(), ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, ignoreCase, foreColor, Nothing, Nothing)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String(), ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, ignoreCase, foreColor, backColor, Nothing)

       End Function

       ''' <summary>
       ''' Matches all the occurrences of the specified strings in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As String(), ByVal ignoreCase As Boolean,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color,
                                       ByVal font As Font) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, ignoreCase, foreColor, backColor, font)

       End Function

#End Region

#Region " Regular Expressions "

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex,
                                       ByVal foreColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, foreColor, Nothing, Nothing)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, foreColor, backColor, Nothing)

       End Function

       ''' <summary>
       ''' Matches all the occurrences of the specified regular expression in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex,
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color,
                                       ByVal font As Font) As Integer

           Return WordFinding.InternalColorizeMatches(sender, {find}, foreColor, backColor, font)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex(),
                                       ByVal foreColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, foreColor, Nothing, Nothing)

       End Function

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex(),
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, foreColor, backColor, Nothing)

       End Function

       ''' <summary>
       ''' Matches all the occurrences of any of the specified regular expressions in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Function ColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                       ByVal find As Regex(),
                                       ByVal foreColor As Global.System.Drawing.Color,
                                       ByVal backColor As Global.System.Drawing.Color,
                                       ByVal font As Font) As Integer

           Return WordFinding.InternalColorizeMatches(sender, find, foreColor, backColor, font)

       End Function

       ''' <summary>
       ''' Matches all the occurrences of the specified regular expression in the source <see cref="WinForms.RichTextBox"/>
       ''' and invokes the specified action for any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Sub IterateMatches(ByVal sender As WinForms.RichTextBox,
                                 ByVal find As Regex,
                                 ByVal action As Action(Of WinForms.RichTextBox, Match))

           WordFinding.InternalIterateMatches(sender, {find}, action)

       End Sub

       <DebuggerStepThrough>
       <Extension>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Sub IterateMatches(ByVal sender As WinForms.RichTextBox,
                                 ByVal find As Regex(),
                                 ByVal action As Action(Of WinForms.RichTextBox, Match))

           WordFinding.InternalIterateMatches(sender, find, action)

       End Sub

#End Region

#End Region

#Region " Private Methods "

       ''' <summary>
       ''' Find all the occurrences of the specified strings in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       ''' <returns>
       ''' Returns the total amount of occurrences found.
       ''' </returns>
       <DebuggerStepThrough>
       Private Function InternalColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                                ByVal find As String(), ByVal ignoreCase As Boolean,
                                                ByVal foreColor As Global.System.Drawing.Color,
                                                ByVal backColor As Global.System.Drawing.Color,
                                                ByVal font As Font) As Integer

           If (foreColor = Nothing) OrElse (foreColor = Color.Empty) Then
               foreColor = sender.ForeColor
           End If

           If (backColor = Nothing) OrElse (backColor = Color.Empty) Then
               backColor = sender.BackColor
           End If

           If (font Is Nothing) Then
               font = sender.Font
           End If

    ' Set letter-case criteria.
    Dim richTextBoxFinds As RichTextBoxFinds =
        If(ignoreCase, RichTextBoxFinds.None, RichTextBoxFinds.MatchCase)
    Dim stringComparison As StringComparison =
        If(ignoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)

           ' Save the current caret position to restore it at the end.
           Dim caretPosition As Integer = sender.SelectionStart

           ' Suspend the control layout logic. And suspend painting events from firing.
           sender.SuspendLayout()
           ElektroKit.Extensions.IWin32Window.SuspendDrawing(sender)

           ' Colorize the matches.
           Dim successCount As Integer = 0
           Dim textLength As Integer = sender.TextLength
           For Each s As String In find

               If String.IsNullOrEmpty(s) Then
                   Continue For
               End If

               Dim firstIndex As Integer = 0
               Dim lastIndex As Integer = sender.Text.LastIndexOf(s, stringComparison)

               While (firstIndex <= lastIndex)
                   Dim findIndex As Integer = sender.Find(s, firstIndex, textLength, richTextBoxFinds)
                   If (findIndex <> -1) Then
                       successCount += 1
                   Else
                       Continue While
                   End If

                   sender.SelectionColor = foreColor
                   sender.SelectionBackColor = backColor
                   sender.SelectionFont = font

                   firstIndex = (sender.Text.IndexOf(s, findIndex, stringComparison) + 1)
               End While ' (firstIndex <= lastIndex)

           Next s

           ' Restore the caret position. Reset selection length to zero.
           sender.Select(caretPosition, length:=0)

           ' Restore the control layout logic. And resume painting events.
           sender.ResumeLayout()
           ElektroKit.Extensions.IWin32Window.ResumeDrawing(sender, redraw:=True)

           Return successCount

       End Function

       ''' <summary>
       ''' Find all the occurrences of the specified regular expressions in the source <see cref="WinForms.RichTextBox"/>
       ''' and set the foreground color, background color, and the font of any occurrence found.
       ''' </summary>
       ''' <returns>
       ''' Returns the total amount of occurrences found.
       ''' </returns>
       <DebuggerStepThrough>
       Private Function InternalColorizeMatches(ByVal sender As WinForms.RichTextBox,
                                                ByVal find As Regex(),
                                                ByVal foreColor As Global.System.Drawing.Color,
                                                ByVal backColor As Global.System.Drawing.Color,
                                                ByVal font As Font) As Integer

           If (foreColor = Nothing) OrElse (foreColor = Color.Empty) Then
               foreColor = sender.ForeColor
           End If

           If (backColor = Nothing) OrElse (backColor = Color.Empty) Then
               backColor = sender.BackColor
           End If

           If (font Is Nothing) Then
               font = sender.Font
           End If

           ' Save the current caret position to restore it at the end.
           Dim caretPosition As Integer = sender.SelectionStart

           ' Suspend the control layout logic. And suspend painting events from firing.
           sender.SuspendLayout()
           ElektroKit.Extensions.IWin32Window.SuspendDrawing(sender)

           ' Colorize the matches.
           Dim successCount As Integer = 0
           For Each rgx As Regex In find

               Dim matches As MatchCollection = rgx.Matches(sender.Text, rgx.Options)
               successCount += matches.Count

               For Each m As Match In matches
                   sender.Select(m.Index, m.Length)
                   sender.SelectionColor = foreColor
                   sender.SelectionBackColor = backColor
                   sender.SelectionFont = font
               Next m

           Next rgx

           ' Restore the caret position. Reset selection length to zero.
           sender.Select(caretPosition, length:=0)

           ' Restore the control layout logic. And resume painting events.
           sender.ResumeLayout()
           ElektroKit.Extensions.IWin32Window.ResumeDrawing(sender, redraw:=True)

           Return successCount

       End Function

       ''' <summary>
       ''' Matches all the occurrences of the specified regular expression in the source <see cref="WinForms.RichTextBox"/>
       ''' and invokes the specified action for any occurrence found.
       ''' </summary>
       <DebuggerStepThrough>
       Private Sub InternalIterateMatches(ByVal sender As WinForms.RichTextBox,
                                          ByVal find As Regex(),
                                          ByVal action As Action(Of WinForms.RichTextBox, Match))

           ' Suspend the control layout logic. And suspend painting events from firing.
           sender.SuspendLayout()
           ElektroKit.Extensions.IWin32Window.SuspendDrawing(sender)

           ' Iterate the matches.
           For Each rgx As Regex In find
               Dim matches As MatchCollection = rgx.Matches(sender.Text, rgx.Options)

               For Each m As Match In matches
                   action.Invoke(sender, m)
               Next m
           Next rgx

           ' Restore the control layout logic. And resume painting events.
           sender.ResumeLayout()
           ElektroKit.Extensions.IWin32Window.ResumeDrawing(sender, redraw:=True)

       End Sub

#End Region

   End Module

End Namespace

#End Region





EJEMPLOS DE USO REAL-WORLD

Form1.vb

Código (vbnet) [Seleccionar]
Class Form1

   ' ...

   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

       Dim rtb As RichTextBox = Me.RichTextBox1

       ' Reset selection.
       With rtb
           .SelectAll()
           .SelectionColor = .ForeColor
           .SelectionBackColor = .BackColor
           .SelectionFont = .Font
           .Select(0, 0)
       End With

       ' Perform a new selection.
       Dim find As String = Me.TextBox1.Text ' The text to find.
       Dim ignoreCase As Boolean = Me.CheckBox1.Checked
       Dim forecolor As Color = Color.LimeGreen
       Dim backcolor As Color = rtb.SelectionBackColor
       Dim font As Font = rtb.SelectionFont

       Dim occurrences As Integer = rtb.ColorizeMatches(find, ignoreCase, forecolor, backcolor, font)
       Me.Label1.Text = String.Format("{0} occurrences", occurrences)

   End Sub

   ' ...

End Class


EJEMPLOS DE USO DE LAS SOBRECARGAS PARA STRING

Código (vbnet) [Seleccionar]
Dim find As String = "Hello World"
Dim forecolor As Color = Color.Red

RichTextBox1.ColorizeMatches(find, True, forecolor)


Código (vbnet) [Seleccionar]
Dim find As String = "Hello World"
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black

RichTextBox1.ColorizeMatches(find, True, forecolor, backcolor)


Código (vbnet) [Seleccionar]
Dim find As String = "Hello World"
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

RichTextBox1.ColorizeMatches(find, True, forecolor, backcolor, font)


Código (vbnet) [Seleccionar]
Dim find As String() = {"Hello", "World"}
Dim forecolor As Color = Color.Red

RichTextBox1.ColorizeMatches(find, True, forecolor)


Código (vbnet) [Seleccionar]
Dim find As String() = {"Hello", "World"}
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black

RichTextBox1.ColorizeMatches(find, True, forecolor, backcolor)


Código (vbnet) [Seleccionar]
Dim find As String() = {"Hello", "World"}
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

RichTextBox1.ColorizeMatches(find, True, forecolor, backcolor, font)


EJEMPLOS DE USO DE LAS SOBRECARGAS PARA EXPRESIONES REGULARES

Código (vbnet) [Seleccionar]
Dim find As New Regex("[0-9]", RegexOptions.None)
Dim forecolor As Color = Color.Red

RichTextBox1.ColorizeMatches(rgx, forecolor)


Código (vbnet) [Seleccionar]
Dim find As New Regex("[0-9]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black

RichTextBox1.ColorizeMatches(rgx, forecolor, backcolor)


Código (vbnet) [Seleccionar]
Dim find As New Regex("[0-9]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

RichTextBox1.ColorizeMatches(rgx, forecolor, backcolor, font)


Código (vbnet) [Seleccionar]
Dim rgx1 As New Regex("[0-9]", RegexOptions.None)
Dim rgx2 As New Regex("[a-z]", RegexOptions.None)
Dim forecolor As Color = Color.Red

RichTextBox1.ColorizeMatches({rgx1, rgx2}, forecolor)


Código (vbnet) [Seleccionar]
Dim rgx1 As New Regex("[0-9]", RegexOptions.None)
Dim rgx2 As New Regex("[a-z]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black

RichTextBox1.ColorizeMatches({rgx1, rgx2}, forecolor, backcolor)


Código (vbnet) [Seleccionar]
Dim rgx1 As New Regex("[0-9]", RegexOptions.None)
Dim rgx2 As New Regex("[a-z]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

RichTextBox1.ColorizeMatches({rgx1, rgx2}, forecolor, backcolor, font)


Código (vbnet) [Seleccionar]
Dim rgx As New Regex("[0-9]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

Dim action As New Action(Of RichTextBox, Match)(
   Sub(rtb As RichTextBox, m As Match)
       With rtb
           .Select(m.Index, m.Length)
           .SelectionColor = forecolor
           .SelectionBackColor = backcolor
           .SelectionFont = font
       End With
   End Sub)
   
RichTextBox1.IterateMatches(rgx, action)


Código (vbnet) [Seleccionar]
Dim rgx1 As New Regex("[0-9]", RegexOptions.None)
Dim rgx2 As New Regex("[a-z]", RegexOptions.None)
Dim forecolor As Color = Color.Red
Dim backcolor As Color = Color.Black
Dim font As New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic)

Dim action As New Action(Of RichTextBox, Match)(
   Sub(rtb As RichTextBox, m As Match)
       With rtb
           .Select(m.Index, m.Length)
           .SelectionColor = forecolor
           .SelectionBackColor = backcolor
           .SelectionFont = font
       End With
   End Sub)
   
RichTextBox1.IterateMatches({rgx1, rgx2}, action)





SOLUCIÓN PARA VISUAL STUDIO 2017

( contiene todo el código fuente de arriba, documentado al completo. )



Nota: los colores de texto y fondo de los controles no se verán igual que en la imagen GIF de arriba, así que es probable que necesiten ajustar dichos colores.








**Aincrad**

#2
Gracias por respoender Elektro .

en internet encontre este codigo que me busca y subralla la palabra que busco en un RichTextbox .

code que encontre en internet:

Código (vbnet) [Seleccionar]
Dim TEMPORAL As String = RichTextBox1.Text
       RichTextBox1.Clear()
       RichTextBox1.Text = TEMPORAL
       Try
           Dim BUSQUEDA As String = InputBox("BUSCAR")
           Dim INDEX As Integer
           While INDEX < RichTextBox1.Text.LastIndexOf(BUSQUEDA)
               RichTextBox1.Find(BUSQUEDA, INDEX, RichTextBox1.TextLength, RichTextBoxFinds.None)
               RichTextBox1.SelectionBackColor = Color.DarkBlue
               INDEX = RichTextBox1.Text.IndexOf(BUSQUEDA, INDEX) + 1
           End While
       Catch ex As Exception
           MsgBox(ex.Message)
       End Try



Pero el Tu codigo esta SUPER . pero al intentar abrirlo con mi vb 2010 me salen miles de errores .


bueno pase el code importante a un boton de mi proyecto pero me sale 1 error .


aqui te dejo el code que extraje y puse en mi proyecto.


Código (vbnet) [Seleccionar]
Dim rtb As RichTextBox = Me.RichTextBox1

       ' Reset selection.
       With rtb
           .SelectAll()
           .SelectionColor = .ForeColor
           .SelectionBackColor = .BackColor
           .SelectionFont = .Font
           .Select(0, 0)
       End With

       ' Perform a new selection.
       Dim find As String = Me.TextBox1.Text ' The text to find.
       Dim ignoreCase As Boolean = Me.CheckBox1.Checked
       Dim forecolor As Color = Color.LimeGreen
       Dim backcolor As Color = rtb.SelectionBackColor
       Dim font As Font = rtb.SelectionFont

       Dim occurrences As Integer = rtb.ColorizeMatches(find, ignoreCase, forecolor, backcolor, font)   ' HE AQUI EL ERROR ME DICE COLORIZEMATCHES NO ES UN MIENBRO DE SYSTEM.WINDOWS.FORM1.WINDOWSAPLICATION10
       Me.Label1.Text = String.Format("{0} occurrences", occurrences)


EL ERROR ME DICE COLORIZEMATCHES NO ES UN MIENBRO DE SYSTEM.WINDOWS.FORM1.WINDOWSAPLICATION10




Eleкtro

#3
Cita de: **Aincrad** en 27 Noviembre 2017, 19:10 PM
en internet encontre este codigo que me busca y subralla la palabra que busco en un RichTextbox .

code que encontre en internet:

Código (vbnet) [Seleccionar]
Dim TEMPORAL As String = RichTextBox1.Text
       RichTextBox1.Clear()
       RichTextBox1.Text = TEMPORAL
       Try
           Dim BUSQUEDA As String = InputBox("BUSCAR")
           Dim INDEX As Integer
           While INDEX < RichTextBox1.Text.LastIndexOf(BUSQUEDA)
               RichTextBox1.Find(BUSQUEDA, INDEX, RichTextBox1.TextLength, RichTextBoxFinds.None)
               RichTextBox1.SelectionBackColor = Color.DarkBlue
               INDEX = RichTextBox1.Text.IndexOf(BUSQUEDA, INDEX) + 1
           End While
       Catch ex As Exception
           MsgBox(ex.Message)
       End Try


Ese código está mal, esta evaluación es incorrecta:
Citar
Código (vbnet) [Seleccionar]
While INDEX < RichTextBox1.Text.LastIndexOf(BUSQUEDA)

...piensa que ocurrirá si el índice es Cero, es decir, si la palabra que quieres buscar está en la posición 0 (dicho de otra forma: justo al principio). Ese algoritmo no lo "procesará".

Puedes hacer la prueba por ti mismo, escribe solo una letra en el RichTextBox, e intenta buscarla/resaltarla con ese código que cojiste por Internet.

La solución es facil:
Código (vbnet) [Seleccionar]
While INDEX <= RichTextBox1.Text.LastIndexOf(BUSQUEDA)

Pero de todas formas no tienes la necesidad de buscar en Internet, al principio de mi comentario te puse una función sencillita y de uso genérico que puedes usar, ¿has intentado usarla?, no requiere que copies nada más, solo esa función.




Cita de: **Aincrad** en 27 Noviembre 2017, 19:10 PM
Pero el Tu codigo esta SUPER . pero al intentar abrirlo con mi vb 2010 me salen miles de errores .

Suena algo lógico, ya que basicamente estás intentando hacer un downgrade de VS2017 a VS2010. En VS2017 el archivo de solución de proyecto tiene campos que VS2010 no soporta (basicamente por que antes no existian), y luego están los cambios de sintaxis en las versiones de VB, y la versión máxima de .NET framework que puedas utilizar en VS2010... (el proyecto de VS2017 usa .NET Framework 4.6 o 4.7, no me fijé, pero es una de esas dos)

Cita de: **Aincrad** en 27 Noviembre 2017, 19:10 PMbueno pase el code importante a un boton de mi proyecto pero me sale 1 error .

aqui te dejo el code que extraje y puse en mi proyecto.

EL ERROR ME DICE COLORIZEMATCHES NO ES UN MIENBRO DE SYSTEM.WINDOWS.FORM1.WINDOWSAPLICATION10

Supongo que cuando dices "el código importante" no te estás refiriendo solo a ese bloque de código de 20 lineas que acabas de mostrar, ¿verdad?. El código importante son todos los trozos de código que mostré en mi otro comentario. La función ColorizeMatches está definida en la clase RichTextBox_Extensions.vb... una de las clases del "código importante" que te mostré.

Te compartí el proyecto de VS2017 precisamente para intentar evitarte este tipo de confusiones, para que vieras como debe quedar todo escrito. Mira, haz una cosa, en el proyecto de VS2017 hay unos archivos con extensión .vb:


  • .\WindowsApp1\Extensions\IWin32Window_Extensions.vb
  • .\WindowsApp1\Extensions\RichTextBox_Extensions.vb
  • .\WindowsApp1\Interop\NativeMethods.vb
  • .\WindowsApp1\Interop\RedrawWindowFlags.vb
  • .\WindowsApp1\Interop\WindowsMessages.vb

Simplemente copia el código de esos archivos en un nuevo proyecto de VS2010. Así te debería funcionar. Es decir, creas esos archivos en un proyecto de VS2010 y copias el código. No es necesario crear las carpetas "Extensions" e "Interop" ni tampoco que le pongas el mismo nombre a los archivos .vb

PD: quizás también quieras copiar el código del form:

  • .\WindowsApp1\Interop\Form1.vb

Saludos!








**Aincrad**

#4
bueno he colocado cada clase a mi proyectos con su mismos nombres pero ahora me dice :

Error 1 'ColorizeMatches' no es un miembro de 'System.Windows.Forms.RichTextBox'.




Eleкtro

#5
Si copiesta todo, entonces es un claro error de namespaces.

Donde te marque el error, reemplaza RichTextBox1.ColorizeMatches por NombrePrincipalDeTuNamespace.ElektroKit.Extensions.RichTextBox.ColorizeMatches. Es decir, escribe el espacio de nombres COMPLETO, y se arreglará.

Ejemplo:
Código (vbnet,2) [Seleccionar]
Sub ...
   NombrePrincipalDeTuNamespace.ElektroKit.Extensions.RichTextBox.ColorizeMatches(Richtextbox1, "buscar texto", ignoreCase, forecolor, backcolor, fuente)
End Sub


Otra forma de solucionarlo: importa el namespace en la clase donde te marque el error. Ejemplo:

Código (vbnet,1,6) [Seleccionar]
Imports NombrePrincipalDeTuNamespace.ElektroKit.Extensions.RichTextBox

Class Form1
...
   Sub ...
       RichTextBox1.ColorizeMatches("buscar texto", ignoreCase, forecolor, backcolor, fuente)
   End Sub
...
End Class


Claro yo no se como tienes puesto los nombres... pero creo que con eso te harás una idea.

Si no lo consigues arreglar por ti mismo, puedes pasarme el proyecto por mensaje privado o por aquí, y te lo arreglo.

Saludos








**Aincrad**

#6
he hecho lo que me dices pero me salen mas errores . por eso te he mandado el proyecto por un mensaje privado. Perdoname por tantas molestias .  ;)




Eleкtro

En la clase Form1 añade esto:
Código (vbnet) [Seleccionar]
Imports RICHTEXTBOX_NUMERAR.ElektroKit.Extensions.RichTextBox

En la clase Drawing, reemplaza esto:
Código (vbnet) [Seleccionar]
Imports ElektroKit.Interop.Win32
por esto otro:
Código (vbnet) [Seleccionar]
Imports RICHTEXTBOX_NUMERAR.ElektroKit.Interop.Win32

Así solucionas todos los errores.

saludos








**Aincrad**