INTELLIGENT WORK FORUMS FOR COMPUTER PROFESSIONALS
Log In
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!
*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
|
Visual Basic (Classic) FAQ
Data conversion
How to convert Rich Text into HTML by AndyGroom
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.
CODEPrivate 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 = "<BR>" 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, "", "</span>") & "<span style='" Lump$ = "{ font-family: " & .SelFontName & "; font-size: " & .SelFontSize & "pt; color: #" & GC$ & "; }" If (A& = 0) Then MainStyle$ = Lump$ HTML$ = HTML$ & Lump$ & "'>" curr_FontFace = .SelFontName curr_FontSize = .SelFontSize curr_ForeColour = .SelColor End If If (curr_Bold <> .SelBold) Then HTML$ = HTML$ & IIf(.SelBold, "<B>", "</B>") curr_Bold = .SelBold End If If (curr_Under <> .SelUnderline) Then HTML$ = HTML$ & IIf(.SelUnderline, "<U>", "</U>") curr_Under = .SelUnderline End If If (curr_Italic <> .SelItalic) Then HTML$ = HTML$ & IIf(.SelItalic, "<I>", "</I>") curr_Italic = .SelItalic End If If (curr_Align <> .SelAlignment) Then HTML$ = HTML$ & IIf((A& <> 0) And (Ended = False), "</P>", "") & "<P style='{ margin-top: 0px; margin-bottom: 0px; }' Align='" & Choose(.SelAlignment + 1, "left", "right", "center") & "'>" 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 & "</P>", "</P>") HTML$ = Replace$(HTML$, "<span style='" & MainStyle$ & "'>", "<span class='core'>") 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 |
|
|
|