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.

Jobs

Visual Basic (Microsoft) Versions 5/6 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.

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

Back to Visual Basic (Microsoft) Versions 5/6 FAQ Index
Back to Visual Basic (Microsoft) Versions 5/6 Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close