DELPHI/Часто задаваемые вопросы и ответы на них/Object Pascal



На главную

Подписка

Новости

Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Object Pascal / Как перевести RTF в HTML?

Как перевести 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 tvasiffriga 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 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,'</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>-','<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

Источник получения информации: http://www.delphimaster.ru