Line by Line Text Cycle
Posted: 2002-06-01
By: ArchiveBot
Viewed: 62
Filed Under:
No attachments for this post
This code will cycle through a text box or rich text box line by line, select the line and place it into a string array. The array will then be passed to another method where it will be placed into a list box excluding the blank lines.
I've seen other code like this but if there is no ending vbCrLf then the last line of the box is not read, I've fixed this and showed how to extract the line information and how to use it.
The code is slowed down using a pause routine that I made about a year ago.
Original Author: rbennett
Assumptions
Assumption is that this code is for beginners to experts
Code
Private Sub Command1_Click()
Call CycleText
End Sub
Sub CycleText()
Dim curPos As Integer, lineStart As Integer, n As Integer
Dim finis As Boolean, breakLoop As Boolean, i As Integer
Dim strArray() As String
lineStart = 1
curPos = 1
n = 0
finis = False
breakLoop = False
Do Until breakLoop
curPos = InStr(lineStart, Form1.RichTextBox1.Text, vbCrLf, vbBinaryCompare)
Form1.RichTextBox1.SelStart = lineStart - 1
If curPos > 1 Then
Form1.RichTextBox1.SelLength = curPos - lineStart
Else
Form1.RichTextBox1.SelLength = (Len(Form1.RichTextBox1.Text) + 1) - lineStart
finis = True
End If
ReDim Preserve strArray(n) As String
strArray(n) = Form1.RichTextBox1.SelText
TimedPause 1
If finis Then breakLoop = True
n = n + 1
lineStart = curPos + 2
curPos = 1
DoEvents
Loop
Call PutInListBox(strArray(), n - 1)
End Sub
Sub PutInListBox(myArray, totalArray As Integer)
Dim i As Integer, listCount As Integer
listCount = 0
For i = 0 To totalArray
If Len(myArray(i)) Then
List1.AddItem myArray(i), listCount
listCount = listCount + 1
End If
Next i
End Sub
Function TimedPause(secs As Long)
Dim secStart As Variant
Dim secNow As Variant
Dim secDiff As Variant
secStart = Format(Now(), "mm/dd/yyyy hh:nn:ss AM/PM")
Do While secDiff < secs
secNow = Format(Now(), "mm/dd/yyyy hh:nn:ss AM/PM")
secDiff = DateDiff("s", secStart, secNow)
Loop
End Function
Comments on this post
No comments have been added for this post.
You must be logged in to make a comment.