RTF в HTML

Материал из DRKB


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

Код содержит интуитивно понятные комментарии и строки на шведском языке, нецелесообразные для перевода.


{ Funktion for att konvertera en RTF-rad till SGML-text. }
function rtf2sgml(text: string): string;
var
  temptext: string;
  start: Integer;
begin
  text := StringReplaceAll(text, '&', '##amp;');
  text := StringReplaceAll(text, '##amp', '&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;

Нижеприведенный кусок кода вырезан из довольно большой программы, вызывающей вышеприведенную функцию.

Я знаю что мог бы использовать потоки вместо использования отдельного файла, но у меня не было времени для реализации этого

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>');


Source: Взято из Советов по Delphi от Валентина Озерова
ID: 04284