Как конвертировать RTF в HTML Когда-то давно я хотел сделать в своём текстовом редакторе функцию для конвертации из RTF в HTML, после долгих часов проведённых в Интернете я нашёл пример, но результат меня разочаровал. Та прога просто копировала текст и вставляла его между заголовками
Code
<HTML><BODY></BODY></HTML>
При этом всё форматирование терялось. И тогда я задумался над воросом: "А как сохранить форматирование?" Ответ напрашивался сам собой, необходимо создать функцию или несколько функций, которые бы анализировали форматирование текста и генерировали бы код для такого же форматировиния HTML - Документа.
Сейчас я выложу код этих функций. ПРЕДУПРЕЖДЕНИЕ: Данный код не универсальный т.е. могут быть ошибки при переводе.
Code
Public Function RTFTOHTML(ObjectRTF As RichTextBox) As String
Dim i As Integer
Dim fcolor As String
Dim fName As String
Dim fSize As String
i = 1
Do Until i = Len(ObjectRTF.Text) + 1
If Asc(Mid(ObjectRTF.Text, i, 1)) = 13 Then RTFTOHTML = RTFTOHTML & "< BR>"
If i = 1 Then
ObjectRTF.SelStart = 1
ObjectRTF.SelLength = 0
RTFTOHTML = RTFTOHTML & "< FONT " & " FACE=" & Chr(34) & _
ObjectRTF.SelFontName & Chr(34) & " Color=" & _
TableConvertPallete(ObjectRTF.SelColor) & " Size=" _
& ObjectRTF.SelFontSize / 3 & ">" & Mid(ObjectRTF.Text, 1, i)
fcolor = ObjectRTF.SelColor
fSize = ObjectRTF.SelFontSize
fName = ObjectRTF.SelFontName
i = i + 1
End If
'====================================================================================
ObjectRTF.SelStart = i
ObjectRTF.SelLength = 0
If Not (fcolor = ObjectRTF.SelColor) Or Not _
(fSize = ObjectRTF.SelFontSize) Or Not _
(fName = ObjectRTF.SelFontName) _
Then 'если произошли изменения форматирования вывести
RTFTOHTML = RTFTOHTML & " < FONT " & " FACE=" & Chr(34) & _
ObjectRTF.SelFontName & Chr(34) & " Color=" & _
TableConvertPallete(ObjectRTF.SelColor) & " Size=" & _
ObjectRTF.SelFontSize / 3 & ">" & Mid(ObjectRTF.Text, i, 1)
'-=================================================================================
Else 'Если изменений не произошло добавить символ к остальным
RTFTOHTML = RTFTOHTML & Mid(ObjectRTF.Text, i, 1)
End If
fcolor = ObjectRTF.SelColor
fSize = ObjectRTF.SelFontSize
fName = ObjectRTF.SelFontName
i = i + 1
Loop
End Function
Public Function TableConvertPallete(ColorNumber As String) As String
If ColorNumber = "255" Then TableConvertPallete = Chr(34) & "Red" & Chr(34)
If ColorNumber = "16711680" Then TableConvertPallete = Chr(34) & "Blue" & Chr(34)
If ColorNumber = "65535" Then TableConvertPallete = Chr(34) & "Yellow" & Chr(34)
If ColorNumber = "65280" Then TableConvertPallete = Chr(34) & "Green" & Chr(34)
If ColorNumber = "16777215" Then TableConvertPallete = Chr(34) & "White" & Chr(34)
If ColorNumber = "986895" Then TableConvertPallete = Chr(34) & "Black" & Chr(34)
If ColorNumber = "16711935" Then TableConvertPallete = "FF00CC"
If ColorNumber = "16776960" Then TableConvertPallete = "00FFFF"
If ColorNumber = "4227327" Then TableConvertPallete = "FF9900"
End Function
P.S. Подобный алгоритм я использовал для написания программы для извлечения стилей из RTF - документа
