a more hands-on approach i guess than PSC... its got quality source-code and tutorials and some of the best support poeple around... the main attraction would be i guess the forums!

My syntax was wrong in the ParseFont Function.  It should be:
Function ParseFont(strColor As String, strSize As String, strFont As String) As String
   Dim strTmpFont As String

   strTmpFont = "<font"
   If strColor <> "" Then
      strTmpFont = strTmpFont & " color=""" & strColor & """"
   End If
   If strSize <> "" And strSize <> "2" Then
       strTmpFont = strTmpFont & " size=" & strSize
   End If
   If strFontFace <> "" Then
       strTmpFont = strTmpFont & " face=""" & strFont & """"
   End If
   strTmpFont = strTmpFont & ">"
   ParseFont = strTmpFont
End Function

Notice the font face now has double quotation marks.

The ProcessWord, /F option - else if replacement should look like this:

           ElseIf IsNumeric(Mid(strWord, 3)) Then 'Font Type
               
               strFontFace = strFontTable(Mid(strWord, 3))
               If strFontFace <> "" Then
               strFont = ParseFont(strFontColor, strFontSize, strFontFace)
                   If InNext("</font>") Then
                       ReplaceInNextBeg "</font>", strFont
                   ElseIf InCodes("</font>") Then
                       PushNext ("</font>")
                       PushNextBeg (strFont)
                       Codes2NextTill "</font>"
                   Else
                       PushNext ("</font>")
                       PushNextBeg (strFont)
                   End If
               End If
           End If

If it doesn't then every some fonts will be ignored.  Sorry again

Here is a list of variables that are not used:
Modular Level:
'Dim gWBPlain As Boolean          'plain will be true after next text
'Dim lColors As Long              '# of colors
'Dim lFonts As Long               '# of fonts
'Dim strBOL As String             'string to include after <br>

within RTFtoHTML:
'    Dim strHTML As String
'    Dim l As Long
'    Dim lTmp As Long
'    Dim lTmp2 As Long
'    Dim lTmp3 As Long
'    Dim lRTFLen As Long
'    Dim lEOS As Long                 'end of section
'    Dim strTmp As String
'    Dim strTmp2 As String
'    Dim strEOS As String             'string to be added to end of section
'    Dim strBOS As String             'string to be added to beginning of section
'    Dim strEOP As String             'string to be added to end of paragraph
'    Dim strBOL As String             'string to be added to the begining of each new line
'    Dim strEOL As String             'string to be added to the end of each new line
'    Dim strEOLL As String            'string to be added to the end of previous line
'    Dim strCurFont As String         'current font code eg: "f3"
'    Dim strCurFontSize As String     'current font size eg: "fs20"
'    Dim strCurColor As String        'current font color eg: "cf2"
'    Dim strFontFace As String        'Font face for current font
'    Dim strFontColor As String       'Font color for current font
'    Dim lFontSize As Integer         'Font size for current font
'    Const gHellFrozenOver = False    'always false
'    Dim gSkip As Boolean             'skip to next word/command
'    Dim strCodes As String           'codes for ascii to HTML char conversion
'    Dim strCurLine As String         'temp storage for text for current line before being added to strHTML
'    Dim strFontCodes As String       'list of font code modifiers
'    Dim gSeekingText As Boolean      'True if we have to hit text before inserting a </FONT>
'    Dim gText As Boolean             'true if there is text (as opposed to a control code) in strTmp
'    Dim strAlign As String           '"center" or "right"
'    Dim gAlign As Boolean            'if current text is aligned
'    Dim strGen As String             'Temp store for Generator Meta Tag if requested
'    Dim strTitle As String           'Temp store for Title if requested



****NOTE****
I have not checked other functions.


Like I said in my first post, this code is a good start and probably saved me a good day or two.... but it has still taken me a day to port this code to something more stable.

 Sorry I keep replying to my self over and over..... but I just wanted to correct myself again....
There were, in fact, at least [5]35 [/5] unused variables!!!!!

Wow.....

Although the colour section worked perfiectly well, it was a bit messy.  Here is a reword of that function:
Function GetColorTable(strSecTmp As String, strColorTable() As String)
Dim i As Integer
   'get font table data and fill in strFontTable array
   
   'We can turn the whole thing into an aray, based of ";", where we ignore the first and last  item.
   ReDim strColorTable(CInt(UBound(Split(strSecTmp, ";")) - 2)) As String
   For i = 1 To UBound(Split(strSecTmp, ";")) - 1
       'We only want the section from the first space to the end....using ";}{" as an array splitter
       strColorTable(i - 1) = GetColor(CStr(Split(strSecTmp, ";")(i)))
   Next i
End Function

Function GetColor(ByVal ColourSection As String) As String
Dim strRed As String
Dim strGreen As String
Dim strBlue As String
   strRed = Hex(CByte(Right(Split(ColourSection, "\")(1), Len(Split(ColourSection, "\")(1)) - 3)))
   If Len(strRed) = 1 Then strRed = "0" & strRed
   strGreen = Hex(CByte(Right(Split(ColourSection, "\")(2), Len(Split(ColourSection, "\")(2)) - 5)))
   If Len(strGreen) = 1 Then strGreen = "0" & strGreen
   strBlue = Hex(CByte(Right(Split(ColourSection, "\")(3), Len(Split(ColourSection, "\")(3)) - 4)))
   If Len(strBlue) = 1 Then strBlue = "0" & strBlue
   GetColor = "#" & strRed & strGreen & strBlue
End Function

Hey,

I tried to use your code, but am quite new to asp and got this error:

Runtimeerror Microsoft VBScript (0x800A000D)
Types do not match: 'rtf2html'

I try to implement it like this:
<%=rtf2html("blaat", "+H")%>

and I put the code in rtf2html.inc wich I include on top of the page I load...

I am making a stupid mistake so please correct me

Greetz,

Rutger

The modified function (GetColorTable) has an error with array construction. This will not work under Windows 95. (crash with an error : Runtime error 9, subscript out of range). Though it works well under 2000/XP.

I found this one (in the proc rtf2html)

Original

   lBOS = InStr(strRTFTmp, "\colortbl")
  If lBOS > 0 Then
      strSecTmp = NabSection(strRTFTmp, lBOS)
      GetColorTable strSecTmp, strColorTable()
  End If

This works

   lBOS = InStr(strRTFTmp, "\colortbl")
  If lBOS > 0 Then
      strSecTmp = NabSection(strRTFTmp, lBOS)
      GetColorTable(strSecTmp, strColorTable)
  End If

This piece of code goes into a never ending loop
       While Len(strRTFTmp) > 0
           strSecTmp = NabNextLine(strRTFTmp)
           While Len(strSecTmp) > 0
               strWordTmp = NabNextWord(strSecTmp)
               If Len(strWordTmp) > 0 Then ProcessWord(strWordTmp)
           End While
       End While

I am using VB.Net has nayone got any suggestions?

hi!

i'll give you a tip in html character codes (well, if you like to extend it...) , why don't you try to look for the html codes in some sites (example, your code in your "select case" statement inside HTMLCode) and try to place it in a "for - next" statement. just get the sequence of the bytecode and try to make a formula to make it more faster and easier for the compiler... even though its my first time to register here in developer fusion, i've got a lot of experiences in programming languages: HTML, ASP, Javascript, VB, C++ (native one), SQL... but at least i tried to help you optimize your code. any help you need from me or tips to give to me, just e-mail me here at eight_bytes@yahoo.com

Try This One...

Here is the code which converts RTF fromat to XML

Include the following references from Project Menu
1. Microsoft Word 8.0 Object Library / I have Microsoft Word 10.0 Object Library
2. Microsoft Scripting Runtime

Insert component from Project Menu
1. Microsoft Internet Controls

Draw an instance of Web Browser
Paste this code : Under Command button Command1

Private Sub Command1_Click()

Dim wordApp As Application
Dim Doc As Document

Dim fso As New FileSystemObject
Dim txtStream As TextStream
       Set wordApp = CreateObject("Word.Application")
         Set txtStream = fso.CreateTextFile(App.Path & "\abc.rtf", True, False)
           txtStream.Write (RichTextBox1.TextRTF)
           txtStream.Close
           Set Doc = wordApp.Documents.Open(App.Path & "\abc.rtf")
           Doc.SaveAs App.Path & "\abc.html", wdFormatHTML
           Doc.Close
           Set Doc = Nothing
   
       WebBrowser1.Navigate (App.Path & "\abc1.html")

End Sub

Type some text in Rtf and click on Command 1

Special characters are not recognize !!
for example: à é '
The function HTMLCode seems to be the one which do the job but it 's not called.
What the matter!

How can I convert html file from charset window-1252 to UTF-8?
You can help me with dll
Thanks

Hi,

I cann't Convert this Code:

"{\rtf1\ansi\ansicpg1252\deff0\deflang1031{\fonttbl{\f0\fnil\fcharset2 Tawfiq;}}
\viewkind4\uc1\pard\f0\fs41\'b4\'c0\'a5\'c3\'b7\'a5\'ba
\par }


Thanks
Samurai