Translate-rtf-to-html


            From: johan@lindgren.pp.se
> lopezj@iluso.ci.uv.es (Agustin Lopez Bueno) writes:
> I need translate the contents of a RTF component to HTML
> with Delphi. Anybody knows how to do this?
This is a routine I use to convert the content of a RichEdit to SGML-code. It does not produce a complete HTML-file but you will have to figure out which RTF-codes you should convert to which HTML-tags.
--------------------------------------------------------------------------------
function rtf2sgml (text : string) : string;
{Funktion för 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','å');
text := stringreplaceall (text,'\'+chr(39)+'c5','Å');
text := stringreplaceall (text,'\'+chr(39)+'e4','ä');
text := stringreplaceall (text,'\'+chr(39)+'c4','Ä');
text := stringreplaceall (text,'\'+chr(39)+'f6','ö');
text := stringreplaceall (text,'\'+chr(39)+'d6','Ö');
text := stringreplaceall (text,'\'+chr(39)+'e9','é');
text := stringreplaceall (text,'\'+chr(39)+'c9','É');
text := stringreplaceall (text,'\'+chr(39)+'e1','á');
text := stringreplaceall (text,'\'+chr(39)+'c1','Á');
text := stringreplaceall (text,'\'+chr(39)+'e0','à');
text := stringreplaceall (text,'\'+chr(39)+'c0','À');
text := stringreplaceall (text,'\'+chr(39)+'f2','ò');
text := stringreplaceall (text,'\'+chr(39)+'d2','Ò');
text := stringreplaceall (text,'\'+chr(39)+'fc','ü');
text := stringreplaceall (text,'\'+chr(39)+'dc','Ü');
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 därför bort
det efter \fs16 och la istället en egen tvätt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hämta och radera allt från start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka från deflang till pard för att få }
text := stringreplace (text,temptext,'');{oavsett vilken lang det är. Norska o svenska är olika}
{Här skall vi plocka bort fs och flera olika siffror beroende på vilka alternativ vi godkänner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall (text,'\fs20','');{10 punkter}
{Nu städar vi istället bort alla tvåsiffriga 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 ','');
text := stringreplaceall (text,'\par \plain\f0\b\ul ','
');
text := stringreplaceall (text,'\plain\f0\b\ul ','
');
text := stringreplaceall (text,'\plain\f0','');
text := stringreplaceall (text,'\par }','
');
text := stringreplaceall (text,'\par ','
');
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 file 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,' ','');
 temptext := stringreplaceall (temptext,'
 ','
');
 temptext := stringreplaceall (temptext,'
'+chr(0),'
');
 temptext := stringreplaceall (temptext,'
','');
 temptext := stringreplaceall (temptext,'
','');
 temptext := stringreplaceall (temptext,'
','
');
 temptext := stringreplaceall (temptext,'','<#MELLIS>
');
 temptext := stringreplaceall (temptext,'<#MELLIS>','');
 temptext := stringreplaceall (temptext,'
','
');
 temptext := stringreplaceall (temptext,'
 ','
');
 temptext := stringreplaceall (temptext,'
-','
_');
 temptext := stringreplaceall (temptext,'
_','_');
 while pos('_',temptext)>0 do
 begin
 application.processmessages;
 temptext2 := hamtastreng (temptext,'_','
');
 temptext := stringreplace (temptext,temptext2+'
',temptext2+'');
 temptext := stringreplace (temptext,'_','-');
 end;
 writeln (F,''+temptext+'');
Examples Delphi
