Как перевести RTF в HTML?

---

Здесь процедура, которую я использую для конвертации содержимого RichEdit в код SGML. Она не создает полноценный HTML-файл, но Вы можете расширить функциональность, указал, какие RTF-коды Вы желаете конвертировать в какие-либо HTML-тэги.

function rtf2sgml (text : string) : string;
{Funktion for att konvertera en RTF-rad till SGML-text.}
var
temptext : string;
start : integer;
begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&');
text := stringreplaceall (text,'\'+chr(39)+'e5','a');
text := stringreplaceall (text,'\'+chr(39)+'c5','A');
text := stringreplaceall (text,'\'+chr(39)+'e4','a');
text := stringreplaceall (text,'\'+chr(39)+'c4','A');
text := stringreplaceall (text,'\'+chr(39)+'f6','o');
text := stringreplaceall (text,'\'+chr(39)+'d6','O');
text := stringreplaceall
(text,'\'+chr(39)+'e9','e');
text := stringreplaceall (text,'\'+chr(39)+'c9','E!
');
text := stringreplaceall (text,'\'+chr(39)+'e1','a');
text := stringreplaceall (text,'\'+chr(39)+'c1','A');
text := stringreplaceall (text,'\'+chr(39)+'e0','a');
text := stringreplaceall (text,'\'+chr(39)+'c0','A');
text := stringreplaceall (text,'\'+chr(39)+'f2','o');
text := stringreplaceall (text,'\'+chr(39)+'d2','O');
text := stringreplaceall (text,'\'+chr(39)+'fc','u');
text := stringreplaceall (text,'\'+chr(39)+'dc','U');
text := stringreplaceall (text,'\'+chr(39)+'a3','?');
text := stringreplaceall (text,'\}','#]#');
text := stringreplaceall (text,'\{','#[#');
text := stringreplaceall (text,'{\rtf1\ansi\deff0\deftab720','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort}
text := stringreplaceall (text,'{\f0\fnil MS Sans Serif;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f1\fnil\fcharset2
Symbol;}','');{Skall alltid tas bort}
text := stringreplaceall !
(text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort}
{I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog darfor bort
det efter \fs16 och la istallet en egen tvatt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka fran deflang till pard for att fa }
text := stringreplace (text,temptext,'');{oavsett vilken lang det ar. Norska o svenska ar olika}
{Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall
(text,'\fs20','');{10 punkter}
{Nu stadar vi istallet bort alla tvasif!
friga fontsize.}
while pos ('\fs',text) >0 do
  begin
    application.processmessages;
    start := pos ('\fs',text);
    Delete(text,start,5);
  end;
text := stringreplaceall (text,'\pard\plain\f0 ','<P>');
text := stringreplaceall (text,'\par \plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0','</MELLIS>');
text := stringreplaceall (text,'\par }','</P>');
text := stringreplaceall (text,'\par ','</P><P>');
text := stringreplaceall (text,'#]#','}');
text := stringreplaceall (text,'#[#','{');
text := stringreplaceall (text,'\\','\');
result := text;
end;

//This is cut directly from the middle of a fairly long save routine that calls the above function.
//I
know I could use streams instead of going through a separate fil!
e but I have not had the time to change this

            utfilnamn := mditted.exepath+stringreplace(stringreplace(extractfilename(pathname),'.TTT',''),'.ttt','') + 'ut.RTF';
             brodtext.lines.savetofile (utfilnamn);
             temptext := '';
             assignfile(tempF,utfilnamn);
             reset (tempF);
             try
                while not eof(tempF) do
                  begin
                     readln (tempF,temptext2);
                     temptext2 := stringreplaceall (temptext2,'\'+chr(39)+'b6','');
                     temptext2 := rtf2sgml (temptext2);
                     if temptext2 <>'' then temptext := temptext+temptext2;
                     application.processmessages;
                  end;
             finally
                    closefile (tempF);

            end;
             deletefile (utfilnamn);
            !
 temptext := stringreplaceall (temptext,'</MELLIS> ','</MELLIS>');
             temptext := stringreplaceall (temptext,'</P> ','</P>');
             temptext := stringreplaceall (temptext,'</P>'+chr(0),'</P>');
             temptext := stringreplaceall (temptext,'</MELLIS></P>','</MELLIS>');
             temptext := stringreplaceall (temptext,'<P></P>','');
             temptext := stringreplaceall (temptext,'</P><P></MELLIS>','</MELLIS><P>');
             temptext := stringreplaceall (temptext,'</MELLIS>','<#MELLIS><P>');
             temptext := stringreplaceall (temptext,'<#MELLIS>','</MELLIS>');
             temptext := stringreplaceall (temptext,'<P><P>','<P>');
             temptext := stringreplaceall (temptext,'<P>
','<P>');
             temptext := stringreplaceall (temptext,'<P&g!
t;-','<P>_');
             temptext := stringreplaceall (temptext,'<P>_','<CITAT>_');
             while pos('<CITAT>_',temptext)>0 do
               begin
                 application.processmessages;
                 temptext2 := hamtastreng (temptext,'<CITAT>_','</P>');
                 temptext := stringreplace (temptext,temptext2+'</P>',temptext2+'</CITAT>');
                 temptext := stringreplace (temptext,'<CITAT>_','<CITAT>-');
               end;
             writeln (F,'<BRODTEXT>'+temptext+'</BRODTEXT>');

Author: johan@lindgren.pp.se

»»» Прислать свои комментарии

Дорогие друзья! Мы рады представить вам новый совместный проект сайтов www.rsdn.ru, delphi.mastak.ru и www.optim.ru - профессиональный журнал для программистов RSDN Magazine.
Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!
На сайте выложен анонс пилотного выпуска журнала, вступительное слово от редакции.