1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
Q>:
Как перевести RTF в HTML?
A>:
Здесь процедура, которую я использую для конвертации содержимого 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','å');
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 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>');
