INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!

Talk With Other Members
Be Notified Of Responses
To Your Posts
Keyword Search
One-Click Access To Your
Favorite Forums
Automated Signatures
On Your Posts
Best Of All, It's Free!

Join Us!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Tek-Tips Posting Policies

Home > Forums > Programmers > Languages > Visual Basic (Classic) > FAQs

Visual Basic (Classic) FAQ

Data conversion

How to convert Rich Text into HTML by AndyGroom

faq222-7218

Posted: 3 Jul 09

This converter uses a RichTextBox to convert rich text into HTML. It supports the main features of a RichTextBox such as fonts, font sizes, font attributes, bullets and text alignment.

CODE

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Function RTFtoHTML(ByVal RTFBox As RichTextBox) As String

 Dim mRGB(2) As Byte
 Const html_Break = " "

 HTML$ = "<html>" & NL & "<body>" & NL
 BullStyle$ = "{ margin-left: 15px; margin-bottom: 0px; margin-top: 0px; }"
 curr_Align = -1
 With RTFBox
 txt$ = .Text
 For A& = 0 To Len(txt$)
 .SelStart = A&

 If (A& <> 0) Then
 If (Mid$(txt$, A&, 2) = "•" & vbTab) Then
 HTML$ = HTML$ & "<UL class='bull'><LI>"
 curr_Bullet = True
 A& = A& + 1
 GoTo s_Skip
 End If
 End If
 If (curr_FontFace <> .SelFontName) Or (curr_FontSize <> .SelFontSize) Or (curr_ForeColour <> .SelColor) Then
 CC& = .SelColor
 CopyMemory mRGB(0), CC&, Len(CC&)
 GC$ = Right$("0" & Hex$(mRGB(0)), 2) & Right$("0" & Hex$(mRGB(1)), 2) & Right$("0" & Hex$(mRGB(2)), 2)
 HTML$ = HTML$ & IIf(A& = 0, "", "") & ""
 curr_FontFace = .SelFontName
 curr_FontSize = .SelFontSize
 curr_ForeColour = .SelColor
 End If
 If (curr_Bold <> .SelBold) Then
 HTML$ = HTML$ & IIf(.SelBold, "", "")
 curr_Bold = .SelBold
 End If
 If (curr_Under <> .SelUnderline) Then
 HTML$ = HTML$ & IIf(.SelUnderline, "", "")
 curr_Under = .SelUnderline
 End If
 If (curr_Italic <> .SelItalic) Then
 HTML$ = HTML$ & IIf(.SelItalic, "", "")
 curr_Italic = .SelItalic
 End If
 If (curr_Align <> .SelAlignment) Then
 HTML$ = HTML$ & IIf((A& <> 0) And (Ended = False), "", "") & ""
 Ended = False
 curr_Align = .SelAlignment
 End If
 If (A& <> 0) Then
 If (Mid$(txt$, A&, 2) = vbCrLf) Then
 If (curr_Bullet = True) Then
 HTML$ = HTML$ & "</UL>"
 Ended = True
 curr_Bullet = False
 Else
 HTML$ = HTML$ & html_Break
 End If
 A& = A& + 1
 ElseIf (Mid$(txt$, A&, 1) = "<") Then
 HTML$ = HTML$ & "<"
 ElseIf (Mid$(txt$, A&, 1) = ">") Then
 HTML$ = HTML$ & ">"
 Else
 HTML$ = HTML$ & Mid$(txt$, A&, 1)
 End If
 End If
s_Skip:
 Next A&
 End With

 HTML$ = Replace$(HTML$, html_Break & "", "")
 HTML$ = Replace$(HTML$, "", "")
 HTML$ = HTML$ & vbCrLf _
 & "<style>" & vbCrLf _
 & "span.core " & MainStyle$ & vbCrLf _
 & "ul.bull " & BullStyle$ & vbCrLf _
 & "</style>" & vbCrLf

 RTFtoHTML = HTML$

End Function

Back to Visual Basic (Classic) FAQ Index
Back to Visual Basic (Classic) Forum

My Archive

My FAQ Archive