kill off top line in an RTB
Hello:
I need to sroll an rtb upward (not talking about scroll bars) when the number of llines gets above a variable limit. I'm not really wanting to resize the RTB either...just want to delete the top line of the RTB (mayt have 1000 lines or so of text).
Code:
nRet = SendMessage(rtbCmdLog.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
Do While nRet > intLineLimit
rtbCmdLog = Mid(rtbCmdLog, InStr(rtbCmdLog, vbCrLf) + 1) 'delete 1st line?
nRet = SendMessage(rtbCmdLog.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&) 'get new line count (reduced lines)
rtbCmdLog.Refresh
Loop 'continue deleting lines at top
I've tried a few variations of this (vbCR, vs vbCrLf, etc), but all I get is a blanked out box (its erasing ALL of the text)...this way is also probably slow since it deals with a potentially huge string.
Re: kill off top line in an RTB
Re: kill off top line in an RTB
Use the sendmessage as you are to get the line count and if over your max then use something like this...
Code:
Dim MyLineArray() As String, LoopCount As Integer, S As String
MyLineArray = Split(RTB.Text, vbNewLine)
'? how many lines over
For LoopCount = HowManyLinesOver To MaxNumberOfLinesYouWant
S = S & MyLineArray(LoopCount) & vbNewLine
Next LoopCount
RTB.Text = S
or inversly you could use the LockWindowUpdate, set the selstart to the line you want to be at the top, sellength to the rest of the text and RTB.Text = RTB.SelText, and finally call the LockWindowUpdate to unlock the window...
Code:
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Sub Form_Load()
RTB.Text = "Test Line 1" & vbNewLine & "Test Line 2" & vbNewLine & "Test Line 3"
End Sub
Private Sub Command1_Click()
Dim StartPosition As Integer
StartPosition = InStr(1, RTB.Text, vbNewLine) + 1
LockWindowUpdate RTB.hWnd
RTB.SelStart = StartPosition
RTB.SelLength = Len(RTB.Text)
RTB.Text = RTB.SelText
RTB.SelStart = Len(RTB.Text)
LockWindowUpdate 0
End Sub
Then of course you could just select the lines you want to delete and use RTB.SelText = ""
Good Luck
Re: kill off top line in an RTB
In case it did not become clear, this is how you delete a line:
You set SelStart to the begin of the line,
then you set SelLength to the position behind the next vbCrLf to mark the line
Then you set SelText to "", deleting the marked text.
Only the problem is, if the line has been split due to word wrapping, because it is longer than the visible horizontal width, you might delete a whole paragraph.
Here is a method which deletes exactly one visible single line from the rtb:
Code:
Private Const WM_KEYDOWN = 256&
...
nRet = SendMessage(rtbCmdLog.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&)
dim e%
rtbCmdLog.SetFocus
Do While nRet > intLineLimit
rtbCmdLog.SelStart = 0 'make sure to be at the top of the file.
SendMessage rtbCmdLog.hWnd, WM_KEYDOWN, vbKeyDown, 0 'move key down
e = rtbCmdLog.SelStart 'get the position of the begin of line 2
rtbCmdLog.SelStart = 0 'back to the beginning
rtbCmdLog.SelLength = e 'mark the line
rtbCmdLog.SelText = "" 'delete the line
nRet = SendMessage(rtbCmdLog.hwnd, EM_GETLINECOUNT, 0&, ByVal 0&) 'get new line count (reduced lines)
rtbCmdLog.Refresh
Loop 'continue deleting lines at top
The method is:
move the cursor home
move the cursor down one line to get the length of the first line with a simulated down-key
set the cursor home and set the SelLength to mark the line
set the SelText to "" to delete the line.
This method takes in account if there is a real vbCrLf or not.
Sorry vb5, it seems you were a little faster'n me. :)
Yes, your proposal seems to work, too.
Re: kill off top line in an RTB
Thanks guys...these do the trick...I did notice that it kills off the coloring of my text (the text has various colors)...I will investigate that effect & what is being deleted out. RTB seems fairly complex.
Lines always start with a blue color & any errors appear at the end of the line in red....the red is being lost, not the blue
On second look it appears that the loss of red color is STARTING OFF ONLY on the incoming (bottom) line once the linelimit/choppping begins to happen (any old colors [pre-line limit] & lost color lines scroll upwards), so perhaps there is something else going on.
Here is how I append with color:
Code:
Public Sub rtbAppendText(NuText As String, aColor As Long)
On Error Resume Next
If chkCmdHidden.Value = 0 And frmMain.bolCmdHidden = True Then Exit Sub
NuText = Replace(NuText, vbLf, "")
With rtbCmdLog
.SelColor = aColor
.SelStart = Len(.Text)
.SelText = .SelText & NuText
End With
End Sub
1 Attachment(s)
Re: kill off top line in an RTB
I testet line deleting in an rtb which has multiple colored lines. Everything worked as expected.
When adding lines, the appending is already done by SelStart = NuText.
Otherwise I used the same code to add lines to the rtb.
I send you the rtb playing form I used.
Change the filename in the Form_Load() to your own file.
The right window shows the rich text commands. Maybe you can spot what happens...
Re: kill off top line in an RTB
Hmmm.... Yes, with some of my posted code the formatting of the RTB's text is lost because it is only using the text, which is different than the textrtf value. So to fix, I guess you would replace RTB.Text with RTB.Textrtf, and Wof, I like yours as it does take into consideration the word wrapping feature of the RTB. I think it would make more sense to use that with plain text (meaning writing, stories, instructions, etc.) but if each line is like a log file entry, then other code as posted would work also...
Good Luck
Re: kill off top line in an RTB
Yes, right. Come to think of it, text is appended in chunks of one line ending in vbCrLf.
So it is possibly best to delete in the same units. So SelLength can be determined as
rtb.SelLength = InStr(rtb.SelStart+1, rtb.Text, vbCrLf) +1
But I think you are mistaken concerning the TextRTF property. It is risky to make changes there unless you don't know the syntax of rich text format.
I invite you to look at the little sample form I had attached in my previous post.
It displays the .Text in the left window and shows the .TextRTF in the right one.
The .TextRTF contains all the formatting commands and is not for direct display or editing.
When you create some colored text in the left window you can see how formatting commands are created in the right one. A colortable is built at the top of the file.
The command /cf1 changes color of the following text to the color which is first in the color table. /par denotes a CrLf or new line. If the text is properly created with color specs and all, nothing should go lost when you delete individual lines.
Re: kill off top line in an RTB
This will auto-scroll to the text length
Code:
Option Explicit
Private Declare Function SendMessage _
Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Const EM_GETFIRSTVISIBLELINE As Long = &HCE
Private Const EM_LINESCROLL As Long = &HB6
Public Sub SetTopIndex(rtb As RichTextBox, ByVal nLine As Long)
Dim nIndex As Long
nIndex = nLine - SendMessage(rtb.hwnd, EM_GETFIRSTVISIBLELINE, 0&, 0&)
Call SendMessage(rtb.hwnd, EM_LINESCROLL, 0&, ByVal nIndex)
End Sub
Private Sub Form_Load()
rtb.Text = ""
rtb.SelText = "This is a text, this is only a text test, which is long"
SetTopIndex rtb, 0
End Sub
Re: kill off top line in an RTB
This is a good one.
Now we only need to know how many lines fit into the window of the rtb,
and how many lines has the text totally, to keep it scrolled so that the last line added is always visible.
Possibly could be done with the TextHeight() function and the height of the rtb window...
Re: kill off top line in an RTB
I'd just create a hidden duplicate and fill it with garbage a few times.