Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to convert Rich Text into HTML

Data conversion

How to convert Rich Text into HTML

by  AndyGroom  Posted    (Edited  )
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 = "<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$ & "&lt;"
         ElseIf (Mid$(txt$, A&, 1) = ">") Then
          HTML$ = HTML$ & "&gt;"
         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
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top