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
Related
So I am making a function that will populate the TableLayoutPanel from FileDialog Result then make a delete button for each row using a loop. Here's the code
Private PathtoFile1 As New List(Of String) 'this will contain all the selected file in the dialogwindow
Private rowLineDrawing As Integer = 0
Private selectedfilecountLineDrawing As Integer
Public Function AttachFileLineDrawing(TLP As TableLayoutPanel)
Dim dr = OpenFileDialog1.ShowDialog
If (dr = System.Windows.Forms.DialogResult.OK) Then
selectedfilecountLineDrawing = OpenFileDialog1.FileNames.Count
For Each FileName In OpenFileDialog1.FileNames
Try
Console.WriteLine(FileName.ToString)
PathtoFile1.Add(FileName.ToString)
Catch SecEx As Security.SecurityException
MessageBox.Show("Security error. Please contact your administrator for details.\n\n" &
"Error message: " & SecEx.Message & "\n\n" &
"Details (send to Support):\n\n" & SecEx.StackTrace)
Catch ex As Exception
'Could Not Load the image - probably permissions-related.
MessageBox.Show(("Cannot display the image: " & FileName.Substring(FileName.LastIndexOf("\"c)) &
". You may not have permission to read the file, or " + "it may be corrupt." _
& ControlChars.Lf & ControlChars.Lf & "Reported error: " & ex.Message))
End Try
Next
'MAKE SOMETHING HERE TO DISPLAY THE SELECTED ITEMS IN THE TABLELAYOUTPANEL OF THE SUBMIT PROGRESS
TLP.Controls.Clear()
TLP.RowCount = 0
rowLineDrawing = 0
For Each Path In PathtoFile1
Dim filepath As New Label
filepath.Text = Path
filepath.Width = Val(360)
'this button is for previewing the file
Dim btnPreview As New Button
AddHandler btnPreview.Click,
Sub(s As Object, e As EventArgs)
Dim btn = CType(s, Button)
MsgBox("This is Preview")
End Sub
'This button is for removing rows in the tablelayoutpanel
Dim btnRmv As New Button
Dim StringToIndex As String = Path 'THIS CATCHES EVERY PATH IN THE LOOP AND STORE IT TO THE VARIABLE WHICH THEN BE USED AS A COMPARABLE PARAMETER FOR THE INDEX SEARCH
Dim index = PathtoFile1.IndexOf(Path)
AddHandler btnRmv.Click,
Sub(s As Object, e As EventArgs)
Dim btn = CType(s, Button)
MsgBox(index)
PathtoFile1.RemoveAt(index) 'THIS LINE OF CODE REMOVE THE SPECIFIC ITEM IN THE LIST USING THE BTNRMV CLICK
'MAKE SOMETHING HERE TO REMOVE THE ROW IN THE TABLELAYOUTAPANEL
End Sub
TLP.SuspendLayout()
TLP.RowStyles.Add(New RowStyle(SizeType.Absolute, 20))
TLP.Controls.Add(filepath, 0, rowLineDrawing)
TLP.Controls.Add(btnPreview, 1, rowLineDrawing)
TLP.Controls.Add(btnRmv, 2, rowLineDrawing)
TLP.ResumeLayout()
rowLineDrawing -= -1
Next
End If
End Function
So I am trying to remove the row in the TableLayoutPanel together with the dynamic control. My approach is removing the selected item in the list and I achieved it properly but can't remove the row in the TableLayoutPanel. Any help is much appreciated!
EDIT
I have tried to use the provided module above but got this error
And got this error
Here is an extension method that will enable you to remove any row from a TableLayoutPanel by index:
Imports System.Runtime.CompilerServices
Public Module TableLayoutPanelExtensions
<Extension>
Public Sub RemoveRowAt(source As TableLayoutPanel, index As Integer)
If index >= source.RowCount Then
Throw New ArgumentOutOfRangeException(NameOf(index),
index,
"The row index must be less than the number of rows in the TableLayoutPanel control.")
End If
'Remove the controls in the specified row.
For columnIndex = 0 To source.ColumnCount - 1
Dim child = source.GetControlFromPosition(columnIndex, index)
If child IsNot Nothing Then
child.Dispose()
End If
Next
'Move controls below the specified row up.
For rowIndex = index + 1 To source.RowCount - 1
For columnIndex = 0 To source.ColumnCount - 1
Dim child = source.GetControlFromPosition(columnIndex, rowIndex)
If child IsNot Nothing Then
source.SetCellPosition(child, New TableLayoutPanelCellPosition(columnIndex, rowIndex - 1))
End If
Next
Next
'Remove the last row.
source.RowCount -= 1
End Sub
End Module
I tested that on 3 column by 4 row TableLayoutPanel containing a Label in each cell executing the following code twice:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
TableLayoutPanel1.RemoveRowAt(1)
End Sub
The result was as expected, i.e. removing the second-from-top row each time. You may need to fiddle a bit more depending on what you want to happen row heights. I had the row heights set to equal percentages so the remaining rows grew proportionally to fill the space. If you want something different, you can add code accordingly. Note that you could create an almost identical method for removing columns.
I'm trying to have this program take a normal English sentence in one text box and with the click of a button convert it into a textese sentence.
Any word that can be shortened will be replaced with the words in a text file.
An example of a line in the text file is
anyone,ne1
There are 52 lines (replacement words).
What would be the best way to approach this problem? Is a nested loop possibly a good route to take?
I don't have much experience and trying to learn the language more so open to trying all methods.
Below is what I have so far before I begin the coding process as I'm not really sure where to head from here. Only the words that are found within the text file will be replaced, so I think I'd use an If/Else statement that would ignore and leave any words not found alone.
Public Class frmTextese
Dim inputData() As String = IO.File.ReadAllLines("Textese.txt")
Private Sub btnTranslate_Click(sender As Object, e As EventArgs) Handles btnTranslate.Click
Dim english As Integer = 0
Dim englishSentence As String = txtEnglish.Text
Dim result() As String
result = englishSentence.Split(englishSentence)
Dim line As String
Dim data() As String
For i As Integer = 0 To (inputData.Length - 1)
line = inputData(i)
data = line.Split(" "c)
Next
'txtTextese.Text =
End Sub
End Class
An image of what I am trying to achieve:
Try this and have a look at the comments to get an idea of what is happening. I should add that strictly speaking, this site isn't a code writing service, but I can't help it sometimes. This also takes into account capitalization of words and common punctuation after the words. It's a bit quick and dirty, but for the basics, it seems to work ok.
Public Class frmTextese
'create a new empty dictionary where we'll add the pairs of english and
'textese words
Dim englishToTextese As New Dictionary(Of String, String)
Private Sub frmTextese_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'load textese dictionary to an array
Dim filedata() As String = IO.File.ReadAllLines("k:\textese.txt")
'Split each line into its elements and add to the dictionary
For Each item As String In filedata
Dim splitstring() As String = item.Split(","c)
englishToTextese.Add(splitstring(0), splitstring(1))
Next
End Sub
Private Function IsCapitalized(word As String) As Boolean
'If the first character in the word is upper case then return true
'else return false
If Mid(word, 1, 1) = Mid(word, 1, 1).ToUpper Then
Return True
Else
Return False
End If
End Function
Private Function GetPunctuation(word As String) As Tuple(Of String, String)
'If the last character in the word is a punctuation mark, return a pair of values which are :
'the word without puctuation, and the punctuation. Else
'return the word and an empty string
Dim result As Tuple(Of String, String)
If "!':;?/.,".Contains(word.Last()) Then
result = New Tuple(Of String, String)(Mid(word, 1, word.Length - 1), word.Last)
Else
result = New Tuple(Of String, String)(word, "")
End If
Return result
End Function
Private Sub btnTranslate_Click(sender As Object, e As EventArgs) Handles btnTranslate.Click
Dim textese As String = ""
'split the text in the txtEnglish textbox into its component words including any punctuation
Dim words() As String = txtEnglish.Text.Split(" "c)
For Each englishWord As String In words
'get the word and any punctuation following it as a pair of items
'and store in punctResult
Dim punctResult As Tuple(Of String, String) = GetPunctuation(englishWord)
Dim texteseWord As String
'store the first item (the word) in englishWord
englishWord = punctResult.Item1
'store the secont item (the punctuation or a blank string) in punctuation
Dim punctuation As String = punctResult.Item2
'If the english word is in the dictionary
If englishToTextese.ContainsKey(englishWord.ToLower) Then
'get the textesevertion
texteseWord = englishToTextese(englishWord.ToLower)
'if the original english word was capiutalized, capitalize the textese word
If IsCapitalized(englishWord) Then
texteseWord = texteseWord.ToUpperInvariant
End If
'add the word to the textese sentence
textese = textese & texteseWord & punctuation & " "
Else
'if the word isn't in the dictionary, add the original english word and its original state
'of capitalization and punctuation to the textese sentence
textese = textese & englishWord & punctuation & " "
End If
Next
'store the new texteze sentence in the textbox
txtTextese.Text = textese
End Sub
End Class
I am programming novel management software, and I need to be able to keep track of the amount of words in the richtextbox accurately. This is what I have so far
Dim Change As Integer
Dim Count As Integer
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
Change = RichTextBox1.Text.Split(" ").ToLookup(Function(x) x).Count()
'Add 1 to the variable Change every time the space bar is pressed
Count = Change
If RichTextBox1.Text = "" Then
Count = 0
'If the textbox is empty, the word count is 0
ElseIf RichTextBox1.Text.EndsWith(" ") = True Then
Count = Change - 1
'take one away from the wordcount variable when the last character is a space
End If
ToolStripStatusLabel2.Text = Count
'Display the wordcount
End Sub
How do I get the code to keep going on multiple lines? So far, the code only runs on the text on the first line. If the user hits enter then keeps typing, the the word count doesnt count the first word on each subsequent lines
You can use something like this in the keydown handler. There may be some special cases for leading and trailing spaces, unless it can be off by 1, and backspaces should be handled.
If e.KeyValue = Keys.Space Or e.KeyValue = Keys.Back Then
ss = rText1.Text.Split
txCount.Text = UBound(ss) + 1
End If
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
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