Search Tools Links Login

Line by Line Text Cycle


Visual Basic 6, or VB Classic

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

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 93 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.