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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

It only took 4 years... 2

Status
Not open for further replies.
AndyGroom

AndyGroom

Programmer
May 23, 2001
972
GB
thread222-1149815

I asked this question in 2005 about converting RTF to HTML because despite both formats being extensively supported by Microsoft there doesn't seem to be a way to convert from RTF into HTML without buying a third party DLL to do it.

After this thread was unanswered I had a stab at writing a converter and it worked OK but it was far from perfect, sometimes using the wrong font or laying things out differently to the RTF. My requirement was quite basic; I needed a converter that would support just the formatting that the RichTextBox supports such as Bold, Italic, Fonts, Bullets and Alignment.

My mistake was probably to over-complicate things by trying to convert the underlying RTF code into HTML. The answer below is much simpler because it uses a RichTextBox itself in the conversion process. It's here in case anyone finds it useful.

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

Public Function RTFtoHTML_New(ByVal RTFBox As RichTextBox) As String

  Dim mRGB(2) As Byte
  
  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_New = HTML$

End Function

Apologies for the 'coded as things occured to me' nature of the code.

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments
 
(Sorry - html_Break is a constant containing "<BR>". If I missed any others just ask.)

- Andy
___________________________________________________________________
If you think nobody cares you're alive, try missing a couple of mortgage payments
 
Why don't you post this as a FAQ? Would be a nice addition...

Illegitimi non carborundum.
 
(Sorry - html_Break is a constant containing "<BR>". If I missed any others just ask.)
Click to expand...

So it is not "<br />" ?
You should always terminate your tags...
;-)

And yes: Do post as FAQ!
[thumbsup]

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell
 
Status
Not open for further replies.

Similar threads

2009luca
  • Locked
  • Question
COUNT all items in trteeview in last level 1
Replies
4
Views
242
2009luca
2009luca
sal21
  • Locked
  • Question
insert shape in cell 4 of column 6 in a msflexgrid 1
Replies
5
Views
149
sal21
sal21
2009luca
  • Locked
  • Question
population of italy live/real time
Replies
11
Views
277
strongm
strongm
sal21
  • Locked
  • Question
allow only letter in textbox 1
Replies
3
Views
102
strongm
strongm
sal21
  • Locked
  • Question
fill combobox in one shot only 2
Replies
13
Views
129
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top