How to color multiple text from richtextbox in vb.net - 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

Related

ArgumentOutOfRangeException when trying to clear combobox

I'm having the following error message appear when trying to run .Clear() on my combobox:
A first chance exception of type 'System.ArgumentOutOfRangeException' occurred in System.Windows.Forms.dll
{"InvalidArgument=Value of '-1' is not valid for 'index'.
Parameter name: index"}
The strange part is, it does the .Clear() before going to the new 'page' in the application, and it works without a problem. Once I'm on the 'page', draw the items in the combobox and try to go to the next 'page' of the application, it calls the function with the clear once again and blows up when it gets to the .Clear(). If I comment out the cbo.DrawMode = DrawMode.OwnerDrawFixed in the code below it also runs as normal, so the problem is definitely with drawing the strings in the combobox (I'm drawing the strings to change the colour of them). Anyways, completely stumped as to how to fix this, any help would be appreciated.
Code is below:
-My clear method
Public Sub ClearCombos()
'Clear Applicant Combos
cboPrimary.Items.Clear() 'crashes when it hits this line
cboJoin1.Items.Clear()
cboJoin2.Items.Clear()
cboJoin3.Items.Clear()
cboJoin4.Items.Clear()
End Sub
Drawing the strings in the comboboxes
Sub CheckForAgeOverage()
c_applicants = {cboPrimary, cboJoin1, cboJoin2, cboJoin3, cboJoin4}
Dim curdate As Date = Date.Now
Dim age As Integer
counter = 0
'Check age of applicants
For Each cbo As ComboBox In c_applicants
If CKeyValuePair.GetComboBoxSelectedKey(c_applicants(counter), True) = instApplicant.applicantId Then
age = Math.Floor(DateDiff(DateInterval.Month, DateValue(instApplicant.BirthDate), curdate) / 12)
If age >= 70 Then
overArray.Add(CKeyValuePair.GetComboBoxSelectedValue(c_applicants(counter)))
End If
cbo.DrawMode = DrawMode.OwnerDrawFixed
Else
For Each j As JoinsBU In instJoins
If CKeyValuePair.GetComboBoxSelectedKey(c_applicants(counter), True) = j.Applicant.applicantId Then
age = Math.Floor(DateDiff(DateInterval.Month, DateValue(j.Applicant.BirthDate), curdate) / 12)
If age >= 70 Then
overArray.Add(CKeyValuePair.GetComboBoxSelectedValue(c_applicants(counter)))
End If
cbo.DrawMode = DrawMode.OwnerDrawFixed
End If
Next
End If
counter += 1
Next
End Sub
The Comboboxes DrawItem event:
Private Sub cbo_DrawItem(sender As System.Object, e As System.Windows.Forms.DrawItemEventArgs) Handles cboPrimary.DrawItem, cboJoin1.DrawItem, cboJoin2.DrawItem, cboJoin3.DrawItem, cboJoin4.DrawItem
Dim brush As Brush = Brushes.Black
Dim text As String = (CType(sender, ComboBox)).Items(e.Index).ToString()
counter = 0
For Each s As String In overArray
If text = overArray(counter) Then
brush = Brushes.Red
Else
brush = Brushes.Black
End If
counter += 1
Next
e.Graphics.DrawString(sender.Items(e.Index).ToString(), e.Font, brush, _
e.Bounds, StringFormat.GenericDefault)
counter = 0
End Sub
It looks like this shouldn't happen, but it obviously is. The actual error might be in this line in the DrawItem handler:
Dim text As String = (CType(sender, ComboBox)).Items(e.Index).ToString()
Try separating the assignment out of the Dim statement, and check the value of e.Index to make sure it is non-negative. If that's the problem, you could probably work around it with an if to make sure e.Index is non-negative.

RichTextBox find and color text visual basic

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

How to remove vb.net Richtextbox lines that not contains specific text?

I use the next code to remove lines from Richtextboxes but that way i can only tell what line to remove. I need to remove all lines that not contains specific text, can this be done with some edits of my code?
1st piece:
Private Property lineToBeRemovedlineToBeRemoved As Integer
2nd piece:
Dim lineToBeRemoved As Integer = 0
lineToBeRemovedlineToBeRemoved = lineToBeRemoved - 0
Dim str As String = RichTextBox1.Lines(lineToBeRemoved)
RichTextBox1.Find(str & vbCr)
RichTextBox1.SelectedText = ""
This code will remove any line from a richtextbox RichTextbox1 that does not contain "Test" on it. Remember to add Imports System.Text.RegularExpressions to the top of your code.
Private Sub RemoveLines()
Dim lines As New List(Of String)
lines = RichTextBox1.Lines.ToList
Dim FilterText = "Test"
For i As Integer = lines.Count - 1 To 0 Step -1
If Not Regex.IsMatch(lines(i), FilterText) Then
lines.RemoveAt(i)
End If
Next
RichTextBox1.Lines = lines.ToArray
End Sub
You code is not close. You should start over. Use a for loop to go through the RichTextBox lines. If the text is not in a line, then delete it. Tip: It may be easier to go from the last line to the first to avoid problems when deleting.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
RTB.Select(RTB.GetFirstCharIndexFromLine(2), RTB.Lines(2).Count)
RTB.SelectionLength = RTB.Lines(2).Length + 1
RTB.SelectedText = ""
End Sub
Try this code, I applied to my prog and it work good.
When use, just ... call dels("unwanted") ==> Line which contain unwanted word will disappear.
Private Sub dels(sw As String)
Dim ud As String = "" 'for keep all we need
Dim cn As Integer = 0 'for avoid empty line
For Each line As String In RichTextBox1.Lines 'for every line in reichtextbox
If Len(line) > 5 Then 'if that line got more than 5 character
If InStr(line.ToLower, sw.ToLower) < 1 Then 'transform them to lower case for better resulted
If cn = 1 Then ud = ud + vbCrLf 'not place new-line if it is first
ud = ud + line 'keep this line if not match ne want delete
cn = 1 'turn-off first line signal
End If
End If
Next
RichTextBox1.Clear() 'empty richtextbox
RichTextBox1.AppendText(ud) 'update richtextbox with the unwanted
End Sub

VB.NET Replace Lines & Task Killer

i have two questions for my VB.NET Project that is codded on .netFrameWork 4.0
1:
For example i have text file "textfile1.txt" now program need to find line "//This Line" and replace next line after "//This Line"
example:
In textfile1.txt
//This Line
Some Code here
I need to replace Some Code here with text from TextBox1.text
2:
I have text file "MultiLineTextBox1" now program need to kill process by name from MultiTextBox1 line by line
example:
In MultiLineTextBox1
notepad
mspain
Notepad and MSPaint need to be killed...
Base on what I understood from your question this is what you are after. Now if there are any adjustments to make then feel free to comment.
Private Sub Question1()
Dim list = File.ReadAllLines("yourFilePath").ToList()
Dim itemCount = list.Count
For i As Integer = 0 To itemCount - 1
If list(i) = "//This Line" AndAlso Not ((i + 1) > itemCount) Then
list(i + 1) = TextBox1.Text
End If
Next
KillProcesses(list)
End Sub
Private Sub Question2()
Dim list = TextBox1.Text.Split(New String() {Environment.NewLine}, StringSplitOptions.None).ToList()
KillProcesses(list)
End Sub
Private Sub KillProcesses(items As List(Of String))
For Each item As String In items.Where(Function(listItem) listItem <> "//This Line") ' Exclude redundant text
Dim processes = Process.GetProcessesByName(item)
For Each process As Process In processes
Try
process.Kill()
Catch
' Do your error handling here
End Try
Next
Next
End Sub
UPDATE: Code below is an updated version to reflect the changes requested in the comments below
Private Sub Question1()
Dim list = File.ReadAllLines("YourFilePath").ToList()
Dim itemCount = list.Count
For i As Integer = 0 To itemCount - 1
If list(i) = "//This Line" Then
If (i + 1 > itemCount - 1) Then ' Check if the current item is the last one in the list, if it is then add the text to the list
list.Add(TextBox1.Text)
Else ' An item exists, so just update its value
list(i + 1) = TextBox1.Text
End If
End If
Next
' Write the list back to the file
File.WriteAllLines(Application.StartupPath & "\test.txt", list)
KillProcesses(list)
End Sub

How can I programmatically remove text from a ReadOnly RichTextBox?

The following code aims to maintain a text buffer in a ReadOnly RichTextBox, with a maximum number of characters stored, and always kept scrolled to the bottom. It streams a realtime log.
But in my attempt to maintain the maximum character count, rtMessages.TextLength() isn't changing after rtMessages.SelectedText = String.Empty and consequently, without the defensive If block, I'd end up with an infinite loop attempting to repeatedly delete the first line of the buffer.
When I remove the ReadOnly-ness of the RichTextBox, this functionality succeeds. Seems a little strange, since AppendText succeeds, but I understand that selection is a different beast.
Can I make it so that a ReadOnly RichTextBox is programmatically modifiable?
Private Sub onNewData(ByRef data As String) Handles _server.clientSentData
' Add new text
rtMessages.SelectionStart = rtMessages.TextLength()
rtMessages.AppendText(data)
' Delete oldest text line-by-line until the whole buffer is shorter than MAX_TEXT_LENGTH characters
Const MAX_TEXT_LENGTH = 200
Dim textLength = rtMessages.TextLength()
While textLength > MAX_TEXT_LENGTH
Dim i As Int16 = 0
Do While rtMessages.GetLineFromCharIndex(i) < 1
i += 1
Loop
rtMessages.Select()
rtMessages.SelectionStart = 0
rtMessages.SelectionLength = i
rtMessages.SelectedText = String.Empty
rtMessages.SelectionLength = 0
If rtMessages.TextLength() = textLength Then
rtMessages.Clear()
rtMessages.AppendText("[buffer trimming algorithm failed]")
Exit While
End If
textLength = rtMessages.TextLength()
End While
' Scroll down
rtMessages.SelectionStart = rtMessages.TextLength()
rtMessages.ScrollToCaret()
End Sub
While trying to replace SelectedText in a ReadOnly RichTextBox doesn't work, using the SelectedRtf does work:
'rtMessages.Select()
'rtMessages.SelectionStart = 0
'rtMessages.SelectionLength = i
'rtMessages.SelectedText = String.Empty
'rtMessages.SelectionLength = 0
rtMessages.Select(0, i)
rtMessages.SelectedRtf = "{\rtf1\ansi}"
rtMessages.SelectionLength = i - 1
Should be replaced by
rtMessages.SelectionLength = i
EDIT #1
By adding the -1 to the SelectionLength, you're missing the last character of the first line. On the second run, only 1 character will be on the first line (the one you missed on the first run). Then you will try to delete a SelectionLength of 0 and you'll get the same TextLength for every other runs and there you go with the infinite loop!
You can remove the read-only parameter, write your appendtext code and then make the richtextbox readonly again.
I know this is an old thread, but you can get around the ReadOnly issue the replacing the following code:
rtMessages.Select()
rtMessages.SelectionStart = 0
rtMessages.SelectionLength = i
rtMessages.SelectedText = String.Empty
rtMessages.SelectionLength = 0
with this:
rtMessages.Text = rtMessages.Text.Substring(i)
I'm not sure if this is better or worse performance, but it gets around the RichTextBox being set as ReadOnly
Edit:
Here is the complete code used to test this (Note: I added the code to a Button.Click for testing)
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Static X As Integer = 0
X += 1
Dim Data As String = "Line " & X.ToString & ControlChars.NewLine
Me.onNewData(Data)
End Sub
Private Sub onNewData(ByRef data As String)
' Add new text
rtMessages.SelectionStart = rtMessages.TextLength()
rtMessages.AppendText(data)
' Delete oldest text line-by-line until the whole buffer is shorter than MAX_TEXT_LENGTH characters
Const MAX_TEXT_LENGTH As Integer = 200
Dim textLength As Integer = rtMessages.TextLength()
While textLength > MAX_TEXT_LENGTH
Dim i As Integer = 0
Do While rtMessages.GetLineFromCharIndex(i) < 1
i += 1
Loop
'rtMessages.Select()
'rtMessages.SelectionStart = 0
'rtMessages.SelectionLength = i
'rtMessages.SelectedText = String.Empty
'rtMessages.SelectionLength = 0
rtMessages.Text = rtMessages.Text.Substring(i)
If rtMessages.TextLength() = textLength Then
rtMessages.Clear()
rtMessages.AppendText("[buffer trimming algorithm failed]")
Exit While
End If
textLength = rtMessages.TextLength()
End While
' Scroll down
rtMessages.SelectionStart = rtMessages.TextLength()
rtMessages.ScrollToCaret()
End Sub