Does anyone know how to remove:confused: the last two lines of a RichTextBox?
Printable View
Does anyone know how to remove:confused: the last two lines of a RichTextBox?
Using normal textbox:
PHP Code:
Private Sub Command1_Click()
i = UBound(Split(Text1.Text, vbCr))
'
If i >= 1 Then
texto = Text1.Text
'
c = 0
For t = Len(texto) To 0 Step -1
If Mid(texto, t, 1) = vbCr Then
c = c + 1
texto = Mid(texto, 1, t - 1)
End If
'
If c = 2 Then GoTo endf
Next
'
endf:
Text1.Text = texto
End If
'
End Sub
or RTB: although it doesn't remove lines, it lets you find them and edit.
Code:Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
Private Const EM_GETLINE = &HC4
Private Const EM_LINELENGTH = &HC1
Private Function ColorWords(ByRef rtb As RichTextBox, _
ByRef sFindString As String, _
ByVal lColor As Long) As Integer
On Error GoTo ErrHandler
Dim lFindLength As Long
Dim lFoundPos As Long
Dim lTempPos As Long
Dim iOptions As Integer
Dim iMatchCount As Integer
' Set search options
iOptions = rtfNoHighlight 'used by default here
If Check1(0).Value = 1 Then iOptions = iOptions + rtfWholeWord
If Check1(1).Value = 1 Then iOptions = iOptions + rtfMatchCase
' Save the string-length
lFindLength = Len(sFindString)
' Search for a single match. Find method returns
' the position of the first character of the item,
' or -1 if no matches are found.
lFoundPos = rtb.Find(sFindString, 0, , iOptions)
' Loop until all occurences are found
Do Until lFoundPos < 0
iMatchCount = iMatchCount + 1
rtb.SelStart = lFoundPos
rtb.SelLength = lFindLength
rtb.SelColor = lColor
lTempPos = lFoundPos + lFindLength
lFoundPos = rtb.Find(sFindString, lTempPos, , iOptions)
Loop
' Return the number of matches
ColorWords = iMatchCount
Exit Function
ErrHandler:
MsgBox "Unexpected error number-" & _
CStr(Err.Number) & _
" occurred in " & Err.Source & _
":" & vbCrLf & vbCrLf & Err.Description
End Function
Private Sub Command1_Click()
ColorWords RichTextBox1, txtSearch.Text, vbRed
End Sub
Private Sub RichTextBox1_Click()
Dim strBuffer As String
Dim lngLength As Long
Dim intCurrentLine As Integer
Dim lngLineNumber As Long
With RichTextBox1
intCurrentLine = .GetLineFromChar(.SelStart)
'get line length
lngLength = SendMessage(.hwnd, EM_LINELENGTH, intCurrentLine, 0)
'resize buffer
strBuffer = Space(lngLength)
'get line text
Call SendMessage(.hwnd, EM_GETLINE, intCurrentLine, ByVal strBuffer)
lngLineNumber = .GetLineFromChar(.SelStart)
MsgBox "You selected line number " & lngLineNumber + 1 & " which says " & strBuffer
End With
End Sub
see my answer to your question at this/in this thread...
http://www.xtremevbtalk.com/showthre...32#post1336232
Good Luck
If I may add a contribution to this:
This takes in account, that the last line might be terminated already with a CrLf.Code:Private RemoveLast2Lines(TBox as control)
Dim p%, i%, a$
If Right$(TBox.Text, 2) = vbCrLf Then a$ = Left$(TBox.Text, Len(TBox.Text) - 2) Else a$ = TBox.Text
i = InStrRev(a$, vbCrLf)
If i Then i = InStrRev(a$, vbCrLf, i)
If i > 1 Then TBox.Text = Left$(a$, i - 1)
End Sub
@Ash: Your code could become slow if the box contains a rather long text.
It would work better if you avoid the texto = Mid(texto, 1, t - 1)
It causes a lot of unnecessary string copy operations
better determine the position only and then do one copy at the end:
Code:For t = Len(texto) To 0 Step -1
If Mid(texto, t, 1) = vbCr Then
c = c + 1
'texto = Mid(texto, 1, t - 1) don't
End If
'
If c = 2 Then Exit For
Next
Text1.Text = left$(texto,t-1)
Really, your way is faster.Quote:
Originally Posted by WoF
Thanks for the tip :)
And i forgot to use "Exit For" because my first idea was with While/Wend.
Yeah, old While...Wend has no Exit While
If you need to exit While...wend on early condition you can use the Do While... Exit Do... Loop construct.
The first sample using 2 consecutive InstrRev() calls should even be faster than the character oriented loop.
Thanks, but i know about Do Loop. I just use While because everyone does where i work (i really can't understand, but this is the template....).Quote:
Originally Posted by WoF
hmm I can't even remember the last time I used a while wend loop but it was likely in the gosub days.
I always use for next, do loop, do while or loop while loops depending on the objective at hand. While wend is basically obsolete and is very limited compared to the do construct.
Mainly because it has no Exit While.
The Do loop incorporates all possibilities including Loop Until
GOTO doesn't count? :)Quote:
Originally Posted by WoF
:D
Do YOU consider exiting a While Wend with a Goto Label as good programming manners?
I use Goto only with On Error :)
Why not split on crlf, redim the upperbound-2 and join on crlf again ?
Would be a lot faster
Never said that. Just commenting on your post...Quote:
Originally Posted by WoF
Quote:
Originally Posted by WoF
@Teranoz:
If you consider a large amount of lines (coupla 1000) it is surely faster, to step back through the text character by character to find the CrLf you want.
Splitting will cause the creation of a huge string array, duplicate all string data from .Text, and in the end you put everything back together. Might be a little faster, if a .Text contains only some 20 or 30 lines, but will cause huge string copying operations with larger amounts of text. The other method needs only one string copy operation.
Nevertheless, splitting is certainly one more approach for this, as we often find more'n one solution for a problem. :)
@David:
Ok. Then the answer is: Goto doesn't count. Not for me. :)Quote:
Originally Posted by dglienna