StoreText

Private Sub Form_Load()
    'Initialize the array
    ReDim gLine(1)
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
    'Check For Action
    CFAct RichTextBox1
End Sub

Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    'Check For Action
    CFAct RichTextBox1
End Sub

Private Sub CFAct(rBox As RichTextBox)
    Dim lstrLastLine As String 'Last active line text
    Dim lstrCurrentLine As String 'Active line text
    Dim gCurLine As Integer 'Current line number
    Static intTotalLines As Integer 'Total lines
    On Error Goto RTBError
    'Get current line for comparrison
    gCurLine = rBox.GetLineFromChar(rBox.SelStart)
    'Compare Lines. Did user change lines?
    If gCurLine <> gLastActiveLine Then
        'Store Last Active Line
        lstrLastLine = SLALine(rBox)
        'lsrtLastLine is now in the array
        'Get text of current line
        lstrCurrentLine = gLine(rBox.GetLineFromChar(rBox.SelStart)) ' - 1)
        'For simple demonstraition only
        'Display last line user was on.
        Text1 = lstrLastLine 'simple use.
        'For simple demonstraition only
        'Display current line is on.
        Text2 = lstrCurrentLine 'simple use.
    End If
    'Update comparison line
    gLastLine = gCurLine
    LastActivePosition = rBox.SelStart
    Exit Sub
    RTBError:
End Sub

Private Function SLALine(rBox As RichTextBox) As String
    Dim i As Integer 'Used To find start of line
    Dim j As Integer 'Used To find End of line
    Dim lineStart As Integer 'Holds start of line
    Dim lineEnd As Integer 'Holds end of line
    Dim TestLine As Integer 'Position comparason
    Dim StartPosition As Integer 'To position Loop start
    Dim theLine As String 'Holds the return string
    On Error Goto RTBError
    'Start on last active line
    StartPosition = LastActivePosition
    'Find lines' starting position
    For i = StartPosition To 1 Step -1
        TestLine = rBox.GetLineFromChar(i)
        If TestLine < gLastActiveLine Then
            Exit For
        End If
    Next
    If i = 0 Then i = 1 '(i can be 0 due To For...Next)
    'Find lines' ending position
    For j = StartPosition To Len(rBox)
        TestLine = rBox.GetLineFromChar(j)
        If TestLine > gLastActiveLine Then
            Exit For
        End If
    Next
    'Treat first line as special case
    If gLastActiveLine = 0 Then
        lineStart = i
        lineEnd = j - i - 1
    Else
        lineStart = i + 2
        lineEnd = j - i - 3
    End If
    theLine = Mid(rBox.Text, lineStart, lineEnd)
    If gLastActiveLine > gLines Then
        gLines = gLines + 1
        ReDim Preserve gLine(gLines + 1)
    End If
    'Store the text line in the array.
    gLine(gLastActiveLine) = theLine
    SLALine = theLine 'Return the text line
    'Update the last line comaprator
    gLastActiveLine = rBox.GetLineFromChar(rBox.SelStart)
    Exit Function
    RTBError:
End Function

Private Sub CleanArray()
    Dim i As Integer
    For i = UBound(gLine) To 0 Step -1
        If gLine(i) <> "" Then Exit For
    Next
    ReDim Preserve gLine(i)
    gLines = i
End Sub

Private Function CodeIt(HTML() As String) As String
    CleanArray
    For i = 0 To UBound(HTML)
        lstr = Trim(HTML(i))
        'The code below is straight maipulation Start HTML (.htm)
        If LCase(Left(lstr, 5) = LCase(".htm ")) Then
            lstr = "<HTML>" + vbCrLf + "<HEAD>" + vbCrLf + _
                "<TITLE>" + Right(lstr, Len(lstr) - 5) + _
                "</TITLE>" + vbCrLf + "</HEAD>" + vbCrLf + "<BODY>"
            'End HTML (.htme)
        ElseIf LCase(Left(lstr, 6) = LCase(".htme ")) Then
            lstr = "</BODY>" + vbCrLf + "</HTML>" + _
                "; " + Right(lstr, Len(lstr) - 6)
            '<H1> HEADER LEVEL 1 (.h1)
        ElseIf LCase(Left(lstr, 4) = LCase(".H1 ")) Then
            lstr = "<H1> " + _
                Right(lstr, Len(lstr) - 4) + "</H1>"
            '<H2> HEADER LEVEL 2 (.h2)
        ElseIf LCase(Left(lstr, 4) = LCase(".H2 ")) Then
            lstr = "<H2> " + _
                Right(lstr, Len(lstr) - 4) + "</H2>"
            '<H3> HEADER LEVEL 3 (.h3)
        ElseIf LCase(Left(lstr, 4) = LCase(".H3 ")) Then
            lstr = "<H3> " + _
                Right(lstr, Len(lstr) - 4) + "</H3>"
            '<H4> HEADER LEVEL 4 (.h4)
        ElseIf LCase(Left(lstr, 4) = LCase(".H4 ")) Then
            lstr = "<H4> " + _
                Right(lstr, Len(lstr) - 4) + "</H4>"
            '<P> Paragraph (.p)
        ElseIf LCase(Left(lstr, 3)) = LCase(".P ") Then
            lstr = "<P> " + Right(lstr, Len(lstr) - 3) + _
                "<BR>"
            '<TABLE> TABLE (.tbl)
        ElseIf LCase(Left(lstr, 5) = LCase(".tbl ")) Then
            lstr = "<Table>" + _
                "; " + Right(lstr, Len(lstr) - 5)
            '</TABLE> END TABLE (.tble)
        ElseIf LCase(Left(lstr, 6) = LCase(".tble ")) Then
            lstr = "</TABLE>" + vbCrLf + _
                "; " + Right(lstr, Len(lstr) - 6)
            '<TR> TABLE ROW (.tr)
        ElseIf LCase(Left(lstr, 4) = LCase(".tr ")) Then
            lstr = "<TR>" + _
                "; " + Right(lstr, Len(lstr) - 4)
            '</TR> END TABLE ROW (.tre)
        ElseIf LCase(Left(lstr, 5) = LCase(".tre ")) Then
            lstr = "</TR>" + _
                "; " + Right(lstr, Len(lstr) - 5)
            '<TD> TABLE DATA (.td)
        ElseIf LCase(Left(lstr, 4) = LCase(".td ")) Then
            lstr = "<TD>" + _
                Right(lstr, Len(lstr) - 4) + "</TD>"
        Else
            lstr = lsrt + " <BR>"
        End If
        'Add to HTML CODE
        newLine = newLine + lstr + vbCrLf
    Next
    CodeIt = newLine
End Function

Name: Text to Array
Description:Takes a page of text and stores lines in array
Returns:Array of text lines

RichTextBox named :RichtextBox1 '
Attributes:MultiLine=True'
TextBox named :Text1 '
Attributes:N/A (Default) '
TextBox named :Text2 '
Attributes:N/A (Default) '
TextBox named :Text3 '
Attributes:MultiLine=True'
The Relavent Code : CFAct(), and SLSLine() '
Global variables (Required)

Dim gLine() As String 'Used To store the text lines.
Dim gLineCount As Integer 'Holds the total line count.
Dim gLastActiveLine As Integer 'Holds the last active line number.
Dim LastActivePosition As Long 'Holds the last active character position.
Dim gLines As Integer 'Holds the total number of lines
Dim gLastLine As Integer ' Compatator
Private Sub Command1_Click()
'Example use

'Text3 has the same dimensions and location as RichTexBox1

'Text3 MuliLine = True

Text3 = CodeIt(gLine)
Text3.Visible = True
End Sub

Private Sub Form_Load()
'Initialize the array

ReDim gLine(1)
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
'Check For Action

CFAct RichTextBox1
End Sub

Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'Check For Action

CFAct RichTextBox1
End Sub

Private Sub CFAct(rBox As RichTextBox)
Dim lstrLastLine As String 'Last active line text
Dim lstrCurrentLine As String 'Active line text
Dim gCurLine As Integer 'Current line number
Static intTotalLines As Integer 'Total lines
On Error Goto RTBError
'Get current line for comparrison

gCurLine = rBox.GetLineFromChar(rBox.SelStart)
'Compare Lines. Did user change lines?

If gCurLine <> gLastActiveLine Then
'Store Last Active Line

lstrLastLine = SLALine(rBox)
'lsrtLastLine is now in the array

'Get text of current line

lstrCurrentLine = gLine(rBox.GetLineFromChar(rBox.SelStart)) ' - 1)
'For simple demonstraition only

'Display last line user was on.

Text1 = lstrLastLine 'simple use.
'For simple demonstraition only

'Display current line is on.

Text2 = lstrCurrentLine 'simple use.
End If
'Update comparison line

gLastLine = gCurLine
LastActivePosition = rBox.SelStart
Exit Sub
RTBError:
End Sub

Private Function SLALine(rBox As RichTextBox) As String
Dim i As Integer 'Used To find start of line
Dim j As Integer 'Used To find End of line
Dim lineStart As Integer 'Holds start of line
Dim lineEnd As Integer 'Holds end of line
Dim TestLine As Integer 'Position comparason
Dim StartPosition As Integer 'To position Loop start
Dim theLine As String 'Holds the return string
On Error Goto RTBError
'Start on last active line

StartPosition = LastActivePosition
'Find lines' starting position

For i = StartPosition To 1 Step -1
TestLine = rBox.GetLineFromChar(i)
If TestLine < gLastActiveLine Then
Exit For
End If
Next
If i = 0 Then i = 1 '(i can be 0 due To For...Next)
'Find lines' ending position

For j = StartPosition To Len(rBox)
TestLine = rBox.GetLineFromChar(j)
If TestLine > gLastActiveLine Then
Exit For
End If
Next
'Treat first line as special case

If gLastActiveLine = 0 Then
lineStart = i
lineEnd = j - i - 1
Else
lineStart = i + 2
lineEnd = j - i - 3
End If
theLine = Mid(rBox.Text, lineStart, lineEnd)
If gLastActiveLine > gLines Then
gLines = gLines + 1
ReDim Preserve gLine(gLines + 1)
End If
'Store the text line in the array.

gLine(gLastActiveLine) = theLine
SLALine = theLine 'Return the text line
'Update the last line comaprator

gLastActiveLine = rBox.GetLineFromChar(rBox.SelStart)
Exit Function
RTBError:
End Function

Private Sub CleanArray()
Dim i As Integer
For i = UBound(gLine) To 0 Step -1
If gLine(i) <> "" Then Exit For
Next
ReDim Preserve gLine(i)
gLines = i
End Sub

Private Function CodeIt(HTML() As String) As String
CleanArray
For i = 0 To UBound(HTML)
lstr = Trim(HTML(i))
'The code below is straight maipulation Start HTML (.htm)

If LCase(Left(lstr, 5) = LCase(".htm ")) Then
lstr = "<HTML>" + vbCrLf + "<HEAD>" + vbCrLf + _
"<TITLE>" + Right(lstr, Len(lstr) - 5) + _
"</TITLE>" + vbCrLf + "</HEAD>" + vbCrLf + "<BODY>"
'End HTML (.htme)

ElseIf LCase(Left(lstr, 6) = LCase(".htme ")) Then
lstr = "</BODY>" + vbCrLf + "</HTML>" + _
"; " + Right(lstr, Len(lstr) - 6)
'<H1> HEADER LEVEL 1 (.h1)

ElseIf LCase(Left(lstr, 4) = LCase(".H1 ")) Then
lstr = "<H1> " + _
Right(lstr, Len(lstr) - 4) + "</H1>"
'<H2> HEADER LEVEL 2 (.h2)

ElseIf LCase(Left(lstr, 4) = LCase(".H2 ")) Then
lstr = "<H2> " + _
Right(lstr, Len(lstr) - 4) + "</H2>"
'<H3> HEADER LEVEL 3 (.h3)

ElseIf LCase(Left(lstr, 4) = LCase(".H3 ")) Then
lstr = "<H3> " + _
Right(lstr, Len(lstr) - 4) + "</H3>"
'<H4> HEADER LEVEL 4 (.h4)

ElseIf LCase(Left(lstr, 4) = LCase(".H4 ")) Then
lstr = "<H4> " + _
Right(lstr, Len(lstr) - 4) + "</H4>"
'<P> Paragraph (.p)

ElseIf LCase(Left(lstr, 3)) = LCase(".P ") Then
lstr = "<P> " + Right(lstr, Len(lstr) - 3) + _
"<BR>"
'<TABLE> TABLE (.tbl)

ElseIf LCase(Left(lstr, 5) = LCase(".tbl ")) Then
lstr = "<Table>" + _
"; " + Right(lstr, Len(lstr) - 5)
'</TABLE> END TABLE (.tble)

ElseIf LCase(Left(lstr, 6) = LCase(".tble ")) Then
lstr = "</TABLE>" + vbCrLf + _
"; " + Right(lstr, Len(lstr) - 6)
'<TR> TABLE ROW (.tr)

ElseIf LCase(Left(lstr, 4) = LCase(".tr ")) Then
lstr = "<TR>" + _
"; " + Right(lstr, Len(lstr) - 4)
'</TR> END TABLE ROW (.tre)

ElseIf LCase(Left(lstr, 5) = LCase(".tre ")) Then
lstr = "</TR>" + _
"; " + Right(lstr, Len(lstr) - 5)
'<TD> TABLE DATA (.td)

ElseIf LCase(Left(lstr, 4) = LCase(".td ")) Then
lstr = "<TD>" + _
Right(lstr, Len(lstr) - 4) + "</TD>"
Else
lstr = lsrt + " <BR>"
End If
'Add to HTML CODE

newLine = newLine + lstr + vbCrLf
Next
CodeIt = newLine
End Function

Name: Text to Array
Description:Takes a page of text and stores lines in array
Returns:Array of text lines

RichTextBox named :RichtextBox1 '
Attributes:MultiLine=True'
TextBox named :Text1 '
Attributes:N/A (Default) '
TextBox named :Text2 '
Attributes:N/A (Default) '
TextBox named :Text3 '
Attributes:MultiLine=True'
The Relavent Code : CFAct(), and SLSLine() '
Global variables (Required)