I have a MultiLine TextBox that is updated over a period of time as an app runs, and I've managed to make it so that the TextBox scrolls to the bottom, ensuring that the latest entry is always shown.
However, sometimes the text is quite long and goes off of the side of the TextBox, so the Horizontal ScrollBar scrolls to the right.
How can I amend the code below so that the ScrollBar is always to the left, meaning that the beginning of lines is always visible? Please note that I do not wish to wrap text, as I can't have one entry on multiple lines. Thanks.
Private Sub UpdateCurrentProgress(ByVal Text As String)
If Text = "" Then Exit Sub
Dim Textbox As TextBox = Me.txtCurrentProgress
If Textbox.Text <> "" Then Text = vbCrLf & Text
Textbox.AppendText(Text)
Textbox.Select(Textbox.TextLength, 0)
Textbox.ScrollToCaret()
End Sub
You can select the first char at the current line like this:
Me.TextBox1.Select(Me.TextBox1.GetFirstCharIndexOfCurrentLine(), 0)
If I understand your problem correctly, then you need to get first the last line index and then select the first char of that line.
Dim lineNumber = textBox1.Lines.Count()-1
textBox1.Select(textBox1.GetFirstCharIndexFromLine(lineNumber), 0)
Related
In MS Access VBA, I have been trying to programmatically insert code into a form's richtext textbox control when the user presses a button. The idea is to put a mark where the user's cursor is at the time the user presses the button--the mark will signify the start of text where the user enters a comment about the text.
However, presumably because the richtext textbox has hidden formatting codes embedded (e.g., <div>, etc.), using .SelStart and .SelLength does not seem to get me to the correct position in the textbox when I am trying to insert the new text. It is consistently inserting the text earlier in the textbox than where the cursor was when the button is clicked, but not a consistent number of characters earlier.
Although I've done a search and found some wonderful functions for inserting text into a standard textbox (e.g., Lebans' InsertAtCursor function), I cannot get those functions to work for richtext textboxes either--that is, they have the same problem as code that I wrote myself; it inserts the new text too early in the existing textbox text.
Anyone have a solution for programmatically inserting new text into a richtext textbox at the cursor position?
Here is code (obviously, I could make the code more efficient, but I was just trying to get something working first) from one of my attempts. It inserts text, but, not at the correct location, presumably due to the richtext formatting that does not visibly appear in the textbox but apparently influences .SelStart position values:
Dim intSelStart As Integer 'this is the starting location of the selection in the note at the time the comment was initially added
Dim strAddComment as String 'this is the string comment that I want to add--it is not the comment itself, it is a flag that will indicate the comment number
strAddComment = "|1`17|" 'the | characters delimit the comment flag; the first number is the comment number so 1 is the first comment, 2 is the second, etc.; the value after the ` is the length of the text selected in the textbox to which the comment applies, e.g., `17 means the comment applies to 17 selected characters
Forms!frmAppt_individual.SetFocus 'set the focus to the main form
Forms!frmAppt_individual.sub_C.SetFocus 'set the focus to the subform so we can get the .Sel property values of the text selected in the textbox on the subform
Forms!frmAppt_individual.sub_C.Form.Controls("Note").SetFocus 'set focus on the control which is required to get the .Sel property values
intSelStart = Forms!frmAppt_individual.sub_C.Form.Controls("Note").SelStart
'now try to insert the comment
Forms!frmAppt_individual.sub_C.Form.Controls("Note") = Left(Forms!frmAppt_individual.sub_C.Form.Controls("Note"), intSelStart) & strAddComment & Mid(Forms!frmAppt_individual.sub_C.Form.Controls("Note"), intSelStart + 1)
So, I am posting code below that worked for me to insert text at the current insertion point into a richtext textbox using VBA code. The use of the PlainText function seemed helpful. Hopefully the code below will help someone else trying to do the same thing.
An explanation of the code:
The function fAddComment is contained in a standard module. fAddComment is called when the user clicks a button btnAddComment on the parent form frmAppt. A subform subNoteForm contains the richtext textbox named tbxNote. The user is expected to have the insertion point at the position in the richtext textbox where the comment reference is inserted; the user may also have a number of characters selected that indicate the range of text to which the comment reference applies. The function fAddComment will determine what comment number the new comment reference will be by counting any existing comment references already in the note. The function will also count the number of characters selected when the comment reference is inserted so that a different function can later locate the comment reference and select the relevant characters. The function adds, at the insertion point, a comment emoji (💬), followed by the comment reference number, followed by a ` character, followed by the number of characters selected when the comment reference was added, ending with a terminating comment emoji. The function returns the string of the comment reference block that was added.
Public Function fAddComment() As String
'this is used to add a new comment reference to the currently showing note
'it returns "" if there is no note
'it returns the string of the comment reference added to the note if a comment reference is successfully added
Dim strBubble As String 'the comment bubble emoji string
strBubble = ChrW(55357) & ChrW(56492) 'the comment bubble emoji
Dim strProgNote As String
Dim intMaxComment As Integer 'this is the maximum comment number found
Dim intSelStart As Integer 'this is the starting location of the selection in the note at the time the comment was initially added
Dim intSelLength As Integer 'this is the selection length in the note at the time the comment was initially added
Dim whr As Integer 'this locates the next comment emoji and the emoji after it
Dim intFoundValue As Integer 'this is the value of the found comment number
Dim strNew As String 'the new string that holds the comment number and length
Dim strSelectedText As String 'the text that is selected
Dim intPosBeforeInsert As Integer 'the position of the insertion point prior to inserting the new comment reference
'first, get the text of the progress note
strProgNote = PlainText(Forms!frmAppt.subNoteForm.Form.Controls("tbxNote"))
If Len(strProgNote) = 0 Then 'there's no note, so don't try to find comments
fAddComment = ""
Exit Function
End If
'get the selection length at the time the comment was initially added
Forms!frmAppt.SetFocus 'set the focus to the main form
Forms!frmAppt.subNoteForm.SetFocus 'set the focus to the subform so we can get the length of the text selected in the textbox on the subform
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SetFocus 'set focus on the control which is required to get the SelLength property
intSelStart = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart
intSelLength = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelLength
strSelectedText = PlainText(Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelText)
'now, find each comment emoji string and get the value
intMaxComment = 0 'default to no comments
whr = 1
Do Until whr = 0
whr = InStr(whr, strProgNote, strBubble)
If whr > 0 Then 'found a comment, check the number
intFoundValue = Val(Mid(strProgNote, whr + 2)) 'the comment emoji consists of 2 characters, not just 1 character
If intFoundValue > intMaxComment Then intMaxComment = intFoundValue 'the new value is greater so make it the highest value now
whr = InStr(whr + 2, strProgNote, strBubble) + 2
End If
Loop
'return the next comment number and the length of the selected string in the note
strNew = strBubble & Trim(str(intMaxComment + 1)) & "`" & Trim(str(intSelLength)) & strBubble
'insert the new comment reference into the note
intPosBeforeInsert = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelLength = 0 'collapse selection
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelText = strNew 'insert the new comment text
'move the insertion point back to the original location and after the comment reference we just added
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart = intPosBeforeInsert + Len(strNew)
fAddComment = strNew 'return the comment string we just added to the note
End Function
In my a form, I have a rich text box with vertical scrollbars. I have set it so that a line is read from a local text file, and added to the existing text in the text box. The following code makes it so that a line is read from the text file, there is 3 seconds of pause, and then another line is read and added to the existing text. This is done the emulate the feeling of a messenger application, so the 3 seconds of pause is absolutely necessary.
However, I have found that whenever a new line is added and there is enough text in the rich text box for the scrollbar to appear, the scrollbar will jump to the top. Every new line is added to the bottom, so this is extremely annoying, because it means the user is sent all the way up to the top of the text every single time there is a new line added.
Is there anything I can do to prevent this? i.e: locking the scrollbar to the bottom? Or having the scrollbar automatically scroll down to the bottom whenever there is a new line added?
If you need any pictures or further code, please let me know.
Dim i As Integer = 0
Call Pause(3)
RichTextBox1.Text = R.ReadLine()
Do Until i = lineCount
Call Pause(3)
RichTextBox1.Text = RichTextBox1.Text + vbCrLf + vbCrLf + R.ReadLine()
i = i + 1
Loop
The pause subroutine:
Public Sub Pause(ByVal seconds As Single)
Dim newDate As Date
newDate = DateAndTime.Now.AddSeconds(seconds)
While DateAndTime.Now.Second <> newDate.Second
Application.DoEvents()
End While
End Sub
After the TextChangedEvent you can try to set the caret to the last postiton and then use ScrollToCaret
Let me be very clear - I am not looking for a static character limit here (Textbox.MaxLength just doesn't cut it.)
I'm making a simple messaging program and I'd like to implement a character limit. The messages are displayed inside a listbox and can't be horizontally scrolled/wrapped. The solution: impose a limit on every message so that users don't accidentally cut off their own messages.
The problem is that 10 small characters are a lot smaller than 10 full width characters. - E.G. i and W:
iiiiiiiiii
WWWWWWWWWW
I'd like to find a way to limit the characters entered into the text box by the actual amount of pixels the string is wide.
so that:
nobody can use all capitals and get cut off, and
nobody can type normally and be stopped by the character limit far earlier than neccesary.
For reference, I'm using Verdana 8.25pt for the listbox.
Any suggestions would be appreciated,
Thanks.
This should do the trick for you. I've deliberately chosen the keyUp event because the user will see the letter typed and it disappearing.
Private Sub TextBox1_TextChanged(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyUp
Dim text1 As String = TextBox1.Text
Dim textboxFont As Font = TextBox1.Font
Dim textSize As Size = TextRenderer.MeasureText(text1, textboxFont)
If textSize.Width > TextBox1.ClientRectangle.Width Then
Dim cursorLocation As Integer = TextBox1.SelectionStart
TextBox1.Text = TextBox1.Text.Remove(cursorLocation - 1, 1)
If cursorLocation > TextBox1.Text.Length Then
TextBox1.SelectionStart = TextBox1.Text.Length
Else
TextBox1.SelectionStart = cursorLocation
End If
End If
End Sub
Basically what is happening is that the text is rendered (not displayed) using the font of the textbox and measured. If the width of the rendered text is greater than the client area of the textbox, the letter is removed at the point it was typed. This can be anywhere in the text box.
If the cursor is at the end of the text when the letter is removed, .net automatically sets the cursor position to the beginning is a letter is removed. So this sub checks if the initial cursor position was a bigger index than the length of the new textbox contents. If so, the cursor is set to the end again. Otherwise it is moved back 1 because a character was deleted.
I have a form with a RichTextBox (RTB) and a listBox.
When the end user selects an item in the listbox, any matched text in the RTB is highlighted (full code removed for brevity).
re = New Regex(txtToFind)
For Each m In re.Matches(rtbMain.Text)
rtbMain.[Select](m.Index, m.Length)
rtbMain.SelectionColor = Color.White
rtbMain.SelectionBackColor = System.Drawing.SystemColors.Highlight
Next
When the user left mouse clicks in the RTB I want the previously highlighted text to be cleared. This is the standard windows behaviour - If you manually select some text in an RTB with the mouse, it is highlighted, click anywhere back in the RTB and the highlighting disappears. My programatically selected text remains selected.
I have some partially working code (below). I can clear all the highlighted text, but it is by process of selecting everything, changing the colour back and then deselecting it again. I know it is not efficient, the RTB flickers and I am sure it is not the correct way to do it. Can I emulate the standard windows behaviour?
Also using my code, it scrolls to the first line when entering the RTB a second time.
I get around this the first time by returning the top visible line index before clearing the text and then selecting that line again afterwards and using ScrollToCaret(). This only works on the first pass. Subsequent MouseDown events select the top row regardless of where the user has clicked so nothing can be manually highlighted in the RTB.
Private Sub rtbMain_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles rtbMain.MouseDown
Dim topIndex As Integer = rtbMain.GetCharIndexFromPosition(New System.Drawing.Point(1, 1))
Dim topLine As Integer = rtbMain.GetLineFromCharIndex(topIndex)
If e.Button = Windows.Forms.MouseButtons.Right Then
'Do nothing (Context Menu)
Else
rtbMain.SelectAll()
rtbMain.SelectionColor = Color.Black
rtbMain.SelectionBackColor = Color.White
rtbMain.DeselectAll()
rtbMain.Select(topIndex, 0)
rtbMain.ScrollToCaret()
End If
End Sub
I need my code to emulate the standard windows behaviour - clear selected text highlighting on MouseDown and leave the mouse cursor where the user has clicked.
Any help anyone can offer is gratefully appreciated.
I think you may be overthinking this one.
In the right click event, try RtbMain.SelectionLength = 0
Problem
In a VB label, if there are more lines than the fixed height can support, then the additional lines get cut off and the user only sees the first couple of lines.
I need it to be completely opposite. I want to see the latest 5 or 6 lines. What that means is that if there is more lines than the fixed height of the label can show, then instead of simply cutting them off, all the lines should move up with the latest one at the bottom. The top lines can be cut off, but the latest one needs to be in the bottom.
Example of what I am trying to do
If you look at a console and enter a command like dir, then it lists the latest directories, but you see latest read directory at the bottom. Basically, you see the latest directory it read. You only see the latest 5 or 6 directories it read instead of seeing every printed line.
Another Example: Look a textbox. If you type in more text than the height, then you see that the textbox autoscrolls with you on the text and shows the latest lines while the older ones keep moving up and eventually get cut-off until you move the scroll bar up. I need it to be exactly the same, except without scroll bars.
One more example: If you set the TextAlign property of the label to Bottom Center, then you see the text move up as you add more lines. The problem occurs when the label is filled with the lines and the text exceeds the height and gets cut off. That shouldn't happen. The text at top should get cut off, but the latest line should keep coming from the bottom.
Solutions recommended by others
The only solution that I have been given is to create a custom control derived from the label.
Is there any other way that this can be done?
Thank You for your help.
Drop a button and a label on a NEW form (so as not to mess up your existing code) and copy and paste the code below and click the button repeatedly and see if this solves your issue.
obviously if it does you still have to mess with the code so it suits your particular needs.
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Static TextLines As Generic.List(Of String) = Nothing
Static SingleLineHeight As Integer = Nothing
Static maxrows As Integer
Static qty As Integer = Nothing
Dim text As String = Nothing
Dim counta As Integer = Nothing
'
'set MAX ROWS
maxrows = 6
' Initalise
If TextLines Is Nothing Then TextLines = New Generic.List(Of String)
If SingleLineHeight = 0 Then
Label1.Text = "Test Line"
SingleLineHeight = Label1.Font.Height
Label1.Text = ""
End If
'
'process
qty = qty + 1
text = "Line Number " & qty
TextLines.Add(text)
Label1.Text = ""
If TextLines.Count > maxrows - 1 Then TextLines.RemoveAt(0)
For counta = 0 To TextLines.Count - 1
Label1.Text = Label1.Text & TextLines(counta) & vbCrLf
Next
End Sub