RichTextBox find and color text visual basic - vb.net

Hi i have a code for finding words from richtextbox and change font color, the code is working but i f i go back and edit the previous text to something that i don't want to color, the color doesn't go away. here is my code
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
Dim S As Integer = RichTextBox1.SelectionStart
Dim html() As String = {"<!DOCTYPE html>", "<html>", "</html>", "<head>", "</head>", "<body>", "</body>", "pre>", "</pre>", "<!DOCTYPE>", "<title>", "</title>", "<a>",
"<abbr>", "<address>", "<area>", "<article>", "<aside>", "<audio>", "<acronym>", "<applet>", "<b>", "<base>", "<bdi>", "<bdo>", "<blockquote>", "<body>", "<br>", "<button>", "<basefont>", "<bgsound>", "<big>", "<blink>"}
For i As Integer = 0 To html.Length - 1
Dim str As String = html(i)
Dim start As Integer = S - str.Length - 1
If (start >= 0) Then
If (RichTextBox1.Text.Substring(start, str.Length).ToLower.Equals(str)) Then
RichTextBox1.SelectionStart = start
RichTextBox1.SelectionLength = str.Length
RichTextBox1.SelectionColor = Color.Green
RichTextBox1.SelectionStart = S
RichTextBox1.SelectionLength = 0
End If
End If
Next
RichTextBox1.SelectionColor = RichTextBox1.ForeColor
End Sub
When i run the code provided by Воля Або Смерть the half of text is colored in different colors.

EDITED: if you want to extend the code to allow properties, the modification is very simple. Just check if the regualr expression match contains a space or not. If so, then look in the allowed array for the match without any regards to the properties, values, etc. Code modified, and image added.
I know you asked for solution to your approach, but I am advising another approach for what you want to accomplish.
You could easily overcome this problem if you used Regular Expression.
The idea is simple..
At the RichTextBox_TextChanged event, a regular expression match maker iterates through all text and looks for any HTML tag (one that begins with < and ends with >) regardless of the text in-between.
Then instead of looping through all valid HTML tags in your array, one simple line can easily tell if the array Contains the element or not.
Here is my (Tested & Working) Code..
Imports System.Text.RegularExpressions
Public Class Form1
Private Sub RichTextBox1_TextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles RichTextBox1.TextChanged
Dim current_cursor_position As Integer = Me.RichTextBox1.SelectionStart
'This is useful to get a hold of where is the current cursor at
'this will be needed once all coloring is done, and we need to return
Dim html() As String = {"<!DOCTYPE html>", "<html>", "</html>", "<head>", "</head>",
"<body>", "</body>", "pre>", "</pre>", "<!DOCTYPE>", "<title>",
"</title>", "<a>", "<abbr>", "<address>", "<area>", "<article>",
"<aside>", "<audio>", "<acronym>", "<applet>", "<b>", "<base>",
"<bdi>", "<bdo>", "<blockquote>", "<body>", "<br>", "<button>",
"<basefont>", "<bgsound>", "<big>", "<blink>", "<img>","</img>",
"<input>","</input>"}
Dim pattern As String = "<(.)*?>"
Dim matches As MatchCollection = Regex.Matches(Me.RichTextBox1.Text, pattern)
For Each match In matches
Me.RichTextBox1.Select(match.index, match.length)
Dim lookFor As String = match.ToString
If match.ToString.Contains(" ") Then 'Checking if tag contains properties
lookFor = match.ToString.Substring(0, match.ToString.IndexOf(" ")) & ">"
'This line will strip away any extra properties, values, and will
' close up the tag to be able to look for it in the allowed array
End If
If html.Contains(lookFor.ToString.ToLower) Then
'The tag is part of the allowed tags, and can be colored green.
Me.RichTextBox1.SelectionColor = Color.Green
Else
'This tag is not recognized, and shall be colored black..
Me.RichTextBox1.SelectionColor = Color.Black
End If
Next
Me.RichTextBox1.SelectionStart = current_cursor_position
'Returning cursor to its original position
Me.RichTextBox1.SelectionLength = 0
'De-Selecting text (if it was selected)
Me.RichTextBox1.SelectionColor = Color.Black
'new text will be colored black, until
'recognized as HTML tag.
End Sub
End Class
PS: you could also avoid expanding your html array of allowed elements, by simply using a regular expression to look for valid HTML tags (with flexibility of spaces between tags, properties and values, etc.
If you wish, I could elaborate on this.

You are actually pretty close. Take the RichTextBox1.SelectionColor = RichTextBox1.ForeColor line out of the loop and you're golden.
For Each elem As String In html
Dim start As Integer = S - elem.Length - 1
If (start >= 0) Then
If (RichTextBox1.Text.Substring(start, elem.Length).ToLower.Equals(elem)) Then
RichTextBox1.SelectionStart = start
RichTextBox1.SelectionLength = elem.Length
RichTextBox1.SelectionColor = Color.Green
RichTextBox1.SelectionStart = S
RichTextBox1.SelectionLength = 0
End If
End If
Next
RichTextBox1.SelectionColor = RichTextBox1.ForeColor

Related

How to match last line of text file in treeview and display text boxes in vb.net?

I have a problem with a sorted TreeView. I select the last line of a text file, then I extract from this text file the last child node added in the TreeView. Where the shoe pinch is that I can't do it! I have tried with the number of lines in this file, but no results. In fact, I do a bit of everything (not of course) to get the selected node to coincide in the treeview and the displays in the text boxes. Below is a screenshot and my code! I don't know if I made myself understood correctly, my English is translated English. Thank you. Claude.
Dim NbLine As Integer = 0
Dim SR As System.IO.StreamReader = New System.IO.StreamReader(OuvrirFichier)
While Not SR.EndOfStream
SR.ReadLine()
NbLine += 1
End While
SR.Close()
Dim lastLine As String = File.ReadLines(OuvrirFichier, Encoding.UTF8) _
.Where(Function(f As String) (Not String.IsNullOrEmpty(f))).Last.ToString
Dim mytext As String = lastLine.Substring(17, 90)
If NbLine > 0 Then
Dim lignesDuFichier As String() = File.ReadAllLines(OuvrirFichier, Encoding.UTF8)
Dim derniereLigne As String = lignesDuFichier(lignesDuFichier.Length - 1)
TreeView1.Focus()
TreeView1.SelectedNode = TreeView1.Nodes(0).Nodes(lignesDuFichier.Length - 1)
End If
Comments in line.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim OuvrirFichier = "C:\Users\maryo\Desktop\Code\Test Empty Line.txt" '"path to file"
'At least you will only be reading the file once
Dim AllLines = File.ReadAllLines(OuvrirFichier)
Dim LinesWithContent = AllLines.Where(Function(s) s.Trim() <> String.Empty)
Dim lastLine = LinesWithContent.Last
Dim mytext As String = lastLine.Substring(17, 90)
Debug.Print(mytext) 'Just checking that you get what was expected
Dim NbLine = AllLines.Length
Dim derniereLigne As String = AllLines(NbLine - 1) 'Another variable to hold last line???
'But this time it could be a blank line.
TreeView1.Focus()
'This makes no sense. An index of a subNode base on the number of lines in the text file
'is supposed to be the SelectedNode
'Why would this be the last node added?
TreeView1.SelectedNode = TreeView1.Nodes(0).Nodes(NbLine - 1)
'You never test the equality of the SelectedNode with mytext
End Sub

VB 2010 - Changing the Color of a word in a Textbox (every copy of the word)

Hello everyone and thanks in advance,
I have a textbox in which some text is being generated. While it's being generated I want to color the word "successfully" with Green and the word "failed" with Red.
I'm using this :
FormtxtBox.Find()("successfully")
FormtxtBox.SelectionColor = Color.YellowGreen
FormtxtBox.SelectionFont = New Font(FormtxtBox.Font.FontFamily, FormtxtBox.Font.Size, FontStyle.Bold)
FormtxtBox.DeselectAll()
FormtxtBox.Find("failed")
FormtxtBox.SelectionColor = Color.Red
FormtxtBox.SelectionFont = New Font(FormtxtBox.Font.FontFamily, FormtxtBox.Font.Size, FontStyle.Bold)
FormtxtBox.DeselectAll()
It's working but the problem I have with it is that it only colours the first "Successfully" or "Failed" string, whereas the textbox has many copies of that word in it. How can I make it color every copy of these words ?
Yep, what Guil said, .Find only finds the first occurrance.
https://msdn.microsoft.com/en-us/library/hfcsf75k(v=vs.110).aspx
I did find this article and modified it slightly:
https://support.microsoft.com/en-us/kb/176643
It recursively searches the RichTextBox, selects the searched for text, and changes the text as specified. You'd need to add an additional parameter for your font if you're changing that as well.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
FindIt(Me.RichTextBox1, "failed", Color.Red)
End Sub
Private Function FindIt(ByRef Box As RichTextBox, ByVal Search As String, ByVal Color As Color, Optional Start As Int32 = 0) As Int32
Dim retval As Int32 'Instr returns a long
Dim Source As String 'variable used in Instr
Try
Source = Box.Text 'put the text to search into the variable
retval = Source.IndexOf(Search, Start) 'do the first search,
'starting at the beginning
'of the text
If retval <> -1 Then 'there is at least one more occurrence of
'the string
'the RichTextBox doesn't support multiple active selections, so
'this section marks the occurrences of the search string by
'making them Bold and Red
With Box
.SelectionStart = retval
.SelectionLength = Search.Length
.SelectionColor = Color
.DeselectAll() 'this line removes the selection highlight
End With
Start = retval + Search.Length 'move the starting point past the
'first occurrence
'FindIt calls itself with new arguments
'this is what makes it Recursive
FindIt = 1 + FindIt(Box, Search, Color, Start)
End If
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
Return retval
End Function

Using Functions in Visual Basic

The program I'm working on has two different functions, one that calculates the number of syllables in a text file, and another that calculates the readability of the text file based on the formula
206.835-85.6*(Number of Syllables/Number of Words)-1.015*(Number of Words/Number of Sentences)
Here are the problems I'm having:
I'm supposed to display the contents of the text file in a multi-line text box.
I'm supposed to display the answer I get from the function indexCalculation in a label below the text box.
I'm having trouble calling the function to actually have the program calculate the answer to be displayed in the label.
Here is the code I have so far.
Option Strict On
Imports System.IO
Public Class Form1
Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click
Me.Close()
End Sub
Private Sub OpenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OpenToolStripMenuItem.Click
Dim open As New OpenFileDialog
open.Filter = "text files |project7.txt|All file |*.*"
open.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)
If open.ShowDialog() = Windows.Forms.DialogResult.OK Then
Dim selectedFileName As String = System.IO.Path.GetFileName(open.FileName)
If selectedFileName.ToLower = "project7.txt" Then
Dim text As String = File.ReadAllText("Project7.txt")
Dim words = text.Split(" "c)
Dim wordCount As Integer = words.Length
Dim separators As Char() = {"."c, "!"c, "?"c, ":"c}
Dim sentences = text.Split(separators, StringSplitOptions.RemoveEmptyEntries)
Dim sentenceCount As Integer = sentences.Length
Dim vowelCount As Integer = 0
For Each word As String In words
vowelCount += CountSyllables(word)
Next
vowelCount = CountSyllables(text)
Label1.Show(indexCalculation(wordCount, sentenceCount, vowelCount))
Else
MessageBox.Show("You cannot use that file!")
End If
End If
End Sub
Function CountSyllables(word As String) As Integer
word = word.ToLower()
Dim dipthongs = {"oo", "ou", "ie", "oi", "ea", "ee", _
"eu", "ai", "ua", "ue", "au", "io"}
For Each dipthong In dipthongs
word = word.Replace(dipthong, dipthong(0))
Next
Dim vowels = "aeiou"
Dim vowelCount = 0
For Each c In word
If vowels.IndexOf(c) >= 0 Then vowelCount += 1
Next
If vowelCount = 0 Then
vowelCount = 1
End If
Return vowelCount
End Function
Function indexCalculation(ByRef wordCount As Integer, ByRef sentenceCount As Integer, ByRef vowelCount As Integer) As Integer
Dim answer As Integer = CInt(206.835 - 85.6 * (vowelCount / wordCount) - 1.015 * (wordCount / sentenceCount))
Return answer
End Function
End Class
Any suggestions would be greatly appreciated.
Here are my suggestions:
update your indexCalculation function to take in Integers, not strings. that way you don't have to convert them to numbers.
remove all of your extra variables you are not using. this will clean things up a bit.
remove your streamreader. it appears you are reading the text via File.ReadAllText
Label1.Show(answer) should be changed to Label1.Show(indexCalculation(wordCount,sentenceCount,vowelCount)) -- unless Label1 is something other than a regular label, use Label1.Text = indexCalculation(wordCount,sentenceCount,vowelCount))
Then for the vowelCount, you need to do the following:
Dim vowelCount as Integer = 0
For Each word as String in words
vowelCount += CountSyllables(word)
Next
Also, add the logic to the CountSyllables function to make it 1 if 0. If you don't want to include the last character in your vowel counting, then use a for loop instead of a for each loop and stop 1 character short.

Flesch Readability Index in Visual Basic

I'm working on a program that is supposed to perform the calculations for the Flesch Readability Index. The program is supposed to read in a text file "Project7.txt", it's then supposed to display the text in a multi-line text box and perform the following calculations:
Count the number of words in the file.
Count the number of syllables in the file.
Count the number of sentences in the file (a sentence can be ended by a ".", "?", "!", or ":"
The program is then supposed to plug the values into the following formula and display the result in a label (label1).
206.835-85.6*(Number of syllables/Number of words) - 1.015*(Number of words/Number of sentences)
Here is the code I have written so far.
Option Strict On
Imports System.IO
Public Class Form1
Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click
Me.Close()
End Sub
Private Sub OpenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OpenToolStripMenuItem.Click
Dim open As New OpenFileDialog
open.Filter = "text files |project7.txt|All file |*.*"
open.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory)
If open.ShowDialog() = Windows.Forms.DialogResult.OK Then
Dim selectedFileName As String = System.IO.Path.GetFileName(open.FileName)
If selectedFileName.ToLower = "project7.txt" Then
Dim doc As String = ""
Dim line As String
Using reader As New StreamReader(open.OpenFile)
While Not reader.EndOfStream
doc += reader.ReadLine
Console.WriteLine(line)
End While
Dim text = File.ReadAllText("Project7.txt")
Dim words = text.Split(" "c)
Dim wordCount = words.Length
Dim separators As Char() = {"."c, "!"c, "?"c, ":"c}
Dim sentences = text.Split(separators, StringSplitOptions.RemoveEmptyEntries)
Dim sentenceCount = sentences.Length
End Using
Else
MessageBox.Show("You cannot use that file!")
End If
End If
End Sub
Function CountSyllables(word As String) As Integer
word = word.ToLower()
Dim dipthongs = {"oo", "ou", "ie", "oi", "ea", "ee", _
"eu", "ai", "ua", "ue", "au", "io"}
For Each dipthong In dipthongs
word = word.Replace(dipthong, dipthong(0))
Next
Dim vowels = "aeiou"
Dim vowelCount = 0
For Each c In word
If vowels.IndexOf(c) >= 0 Then vowelCount += 1
Next
Return vowelCount
End Function
End Class
Any suggestions are appreciated. Thanks in advance for the help.
Is the code always reporting one more sentence than there actually is?
If so take a look at this from the String.Split method MSDN docs:
When the Split function encounters two delimiters in a row, or a
delimiter at the beginning or end of the string, it interprets them as
surrounding an empty string ("")...
I'm sure your last sentence ends with your sentence delimiter so what's happening is your assignment to sentences is getting an extra, empty array element. See for yourself by breakpointing the line after your assignment and hovering your mouse over sentences. Examine the contents of the array.
The fix is to call Split with the option to remove empty array values. To do that though you'll need to call the Split overload that takes an array of Char for the delimiters:
Replace this line:
Dim sentences = text.Split("."c, "!"c, "?"c, ":"c)
With this:
Dim separators As Char() = {"."c, "!"c, "?"c, ":"c}
Dim sentences = text.Split(separators, StringSplitOptions.RemoveEmptyEntries)
And you should be good.

How to color multiple text from richtextbox in vb.net

So I made a chat in vb.net (using FTP server) and I want to color each name from my chat
so the file with messages is something like the following:
#2George: HI
#2George: Hi geoo
and using RichTextBox1 textchanged event I add:
For Each line In RichTextBox1.Lines
If Not line Is Nothing Then
If line.ToString.Trim.Contains("#2") Then
Dim s$ = line.Trim
RichTextBox1.Select(s.IndexOf("#") + 1, s.IndexOf(":", s.IndexOf("#")) - s.IndexOf("#") - 1)
MsgBox(RichTextBox1.SelectedText)
RichTextBox1.SelectionColor = Color.DeepSkyBlue
End If
End If
Next
the first name (George) changed his color but the second one didn't.
Any ideas why this is happening?
The main problem is that your IndexOf calculations are using the index of the current line, but you are not translating that index to where that line is being used in the RichTextBox. That is, your second line of #2George: Hi geoo is finding an index of 0 for the # sign, but index 0 in the RichTextBox is referring to the line #2George: HI, so you keep redrawing the first line every time.
To fix the immediate problem:
For i As Integer = 0 To RichTextBox1.Lines.Count - 1
Dim startIndex As Integer = RichTextBox1.Text.IndexOf("#", _
RichTextBox1.GetFirstCharIndexFromLine(i))
If startIndex > -1 Then
Dim endIndex As Integer = RichTextBox1.Text.IndexOf(":", startIndex)
If endIndex > -1 Then
RichTextBox1.Select(startIndex, endIndex - startIndex)
RichTextBox1.SelectionColor = Color.DeepSkyBlue
End If
End If
Next
The next problem is that doing this in the TextChanged event re-draws all the lines all the time. That won't scale too well. Consider drawing the text before you add it to the control by using a preformatted RTF line. Something like this:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
AddRTFLine("#2George", "Hi")
AddRTFLine("#2George", "Hi geoo")
End Sub
Private Sub AddRTFLine(userName As String, userMessage As String)
Using box As New RichTextBox
box.SelectionColor = Color.DeepSkyBlue
box.AppendText(userName)
box.SelectionColor = Color.Black
box.AppendText(": " & userMessage)
box.AppendText(Environment.NewLine)
box.SelectAll()
RichTextBox1.Select(RichTextBox1.TextLength, 0)
RichTextBox1.SelectedRtf = box.SelectedRtf
End Using
End Sub