VPF::RTF2HML - Форум программистов

Snowy

Дата 29.3.2006, 12:18 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Нужно сконвертировать RTF в HTML.
Стандарт минимальный RTF 1.0 - только фонт (размер, цвет, стиль и т.д.), выравнивание и пункты.
В идеале нужно получить функцию RtfToHtml(rtf: string): string;
Вот, сижу мучаюсь. Результат пока на 2 с плюсом. Какой-то есть, но неудовлетворительный.
Нашел на тори 2 решения.
Одно хорошее, но нерабочее.
Второе рабочее, но десятки килобайт кода.
Почесал тыковку, решил, что проще будет делать анализ позиционный, как в теме "RTF: Форматирован ли текст". Но что-то плохо работает.
Может кто видел готовое решение?
В принципе, если помучаться, то рожу решение до конца дня.
Но, если кто-то может помочь - буду рад.

P.S. Код из DRKB вообще непонятно что делает в FAQ.
Я понимаю, что он что-то конвертирует. Но никакого отношения к RTF и HTML он не имеет, хотя гордо лежит там именно под этим заголовком.

Демо

Дата 29.3.2006, 12:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

В PM ссылку отправил.

--------------------

Guedda

Дата 29.3.2006, 12:55 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

А может ссылку сюда кинешь?
А то многим интересен этот вопрос. Я не исключение.

--------------------

Ll 2

MIX55

Дата 29.3.2006, 13:00 (ссылка)

(нет голосов)

Загрузка ...

много работы

Профиль
Группа: Awaiting Authorisation
Сообщений: 208
Регистрация: 23.10.2005
Где: Здесь

Репутация: 3
Всего: 4

я вот нашел модуль RTF2HTML правда для Visual Basic'a если что могу ссылку кинуть

--------------------

Hарод, а как в дельфи писать паскалевские проги....?*********************************************Жизнь слишком коротка, чтобы писать на Assembler'e

Демо

Дата 29.3.2006, 13:05 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Цитата(Guedda @ 29.3.2006, 12:55

)

А может ссылку сюда кинешь?
А то многим интересен этот вопрос. Я не исключение.

Политика сайта не позволяет. Пусть Snowy это сделает-)

--------------------

Matematik

Дата 29.3.2006, 13:08 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 17
Всего: 50

Цитата(Демо @ 29.3.2006, 13:05

)

Политика сайта не позволяет

Зато правила не запрещают, а значит можно.
Добавлено @ 13:09
Мне тоже очень интересен данный вопрос.

Демо

Дата 29.3.2006, 13:19 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Цитата(Matematik @ 29.3.2006, 13:08

)

Зато правила не запрещают, а значит можно.

Ну у меня не один, и не 2 постинга уже порезали. Какой смысл давать такие ссылки тогда?

--------------------

Snowy

Дата 29.3.2006, 13:29 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Демо, посмотрел. Первый вариант уж слишком ограничен. Пропускает максимум возможного.
Второй вариант ('rtf2html © 2001 by Johannes Tronkle') на 4 с плюсом.
Немного плавают шрифты, не всегда цвет текста попадает. Но в целом хорошо.
Если бы не кол-во кода.
Думаю, у меня получится гораздо меньше. Да и с размерами шрифта поточнее будет.
Мне осталось исправить закрытие только что открытых тегов и сделать тэги параграфа.

Демо

Дата 29.3.2006, 13:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Snowy,

;)

--------------------

Guedda

Дата 29.3.2006, 13:39 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Может хотя бы коды выложите, а ссылку не надо?
Ну очень интересно, как это реализовывают люди...

--------------------

Ll 2

Демо

Дата 29.3.2006, 13:40 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Код


unit main;
(*
 rtf2html
 (c) 2001 by Johannes Trфnkle ([email protected])

 Dieses Programm konvertiert eine RTF-Datei in eine HTML-Datei.

 F№r nфhere Informationen verweise ich auf das Tutorial unter
 www.delphi-source.de, f№r das dieses Programm erstellt wurde.

 Sollte dieses Projekt irgendjemand weiterhelfen, so wфre ich
 f№r einen kurzen Hinweis dankbar.
*)
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons, ExtCtrls;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Source: TRichEdit;
    Dest: TMemo;
    Splitter1: TSplitter;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin

 Source.Align:=alClient;

end;

procedure TMainForm.SpeedButton2Click(Sender: TObject);
begin
 if OpenDialog.Execute then Source.Lines.LoadFromFile(OpenDialog.FileName);
end;

procedure TMainForm.SpeedButton3Click(Sender: TObject);
begin
 if SaveDialog.Execute then Dest.Lines.saveToFile(SaveDialog.FileName);
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
var loop,loop2:integer; // Counter
    s,s2:string; // Strings, zur Bearbeitung
    fett,kursiv,us,bullet:boolean; // welche Attribute hatte das letzte Zeichen?
    Aktcolor:tColor; // aktuelle Farbe
    aktSize:integer; // aktuelle SchriftgrЎ▀e
    AktLine:Integer; // welche Zeile bearbeiten wir
    Align:TAlignment; // wie ist die Ausrichtung
    ReihenFolge:TList; // in welche Reihenfolge werden die Tags bearbeitet
     // 1= fett
     // 2 = kursiv
     // 3 = unterstrichen
     // 4 = Color
     // 5 = Size
     // 6 = li

 function CalculateSize(pt:integer):integer;
 // Umrechung der SchriftgrЎ▀e in Pixel in ein HTML-Format
 // Die Einteilung ist vЎllig willk№rlich und wurde von mir so gewфhlt.
 // Wer etwas anderes will, kann das hier фndern
 begin
  case pt of
   0..7: result:=1;
   8..10: result:=2;
   11..13: result:=3;
   14..16: result:=4;
   17..20: result:=5;
   21..24: result:=6;
   else result:=7;
  end;
 end; // CalculateSize;

begin
 Source.Visible:=false;
 Source.Width:=32000;

 Dest.Lines.Clear;
 ReihenFolge:=TList.Create;

 // der Header
 s:=
 '<html><head><title>'+OpenDialog.FileName+'</title><meta name="generator" content="Johannes'' rtf2html-Konverter"></head>'+
 '<body text="#000000" bgcolor="#FFFFFF" link="#FF0000" alink="#FF0000" vlink="#FF0000">';

 fett:=false;
 kursiv:=false;
 us:=false;
 bullet:=false;

 // wieviele Zeichen insgesamt
 Source.SelectAll;
 loop2:=Source.SelLength;

 // die Daten des ersten Zeichens herausfinden
 Source.SelLength:=1;
 AktColor:=Source.SelAttributes.Color;
 AktSize:=CalculateSize(Source.SelAttributes.Size);
 Align:=Source.Paragraph.Alignment;

 // erstmal eine vЎllig willk№rliche Reihenfolge festlegen
 ReihenFolge.Add(Pointer(1));
 ReihenFolge.Add(Pointer(2));
 ReihenFolge.Add(Pointer(3));
 ReihenFolge.Add(Pointer(4));
 ReihenFolge.Add(Pointer(5));
 ReihenFolge.Add(Pointer(6));

 AktLine:=0;

 // Die Fonteinstellungen des ersten Zeichens
 s:=s+'<font size="'+IntToStr(aktsize)+'" color="#'+IntToHex(GetRValue(AktColor),2)+IntToHex(GetGValue(AktColor),2)+IntToHex(GetBValue(AktColor),2)+'">';

 // Der erste Paragraph
 case Align of
  taLeftJustify:s:=s+'<p align="left">';
  taRightJustify:s:=s+'<p align="right">';
  taCenter:s:=s+'<p align="center">';
 end;

 for loop:=0 to loop2 do
  begin
   // immer das nфchste zeichen
   Source.SelStart:=loop;
   Source.SelLength:=1;

   // jetzt wird geschaut, ob sich etwas getan hat
   with Source.SelAttributes do
    begin

   // Testen, ob wir eine neue Zeile erreicht haben, wenn ja,
   // dann entweder neuer Paragraph oder <br>
   if AktLine <> SendMessage (Source.Handle, EM_LINEFROMCHAR,
                              Source.SelStart, 0) then
    begin
     // wenn wir in einer Aufzфhlung sind, dann wird durch eine neue
     // Zeile diese immer abgeschlossen
     if bullet then
      begin
       s:=s+'</li>';
       bullet:=false;

       ReihenFolge.Move(ReihenFolge.IndexOf(Pointer(6)),ReihenFolge.Count-1);
       // wenn in der neuen Zeile nicht wieder eine Aufzфhlung ist,
       // dann erstellen wir eine neue Zeile
       if Source.Paragraph.Numbering <> nsBullet then
        begin
        // Bevor wir in die neue Zeile wechseln, schlie▀en wir alle offenen Tags
        for loop2:=0 to ReihenFolge.Count-1 do
         case Integer(Reihenfolge[loop2]) of
          1: if fett then s:=s+'</b>';
          2: if kursiv then s:=s+'</i>';
          3: if us then s:=s+'</u>';
          4: s:=s+'</font>';
         end; // case
        fett:=false;
        kursiv:=false;
        us:=false;

         s:=s+'<br>';
        end;
      end
      else
      begin
       if Trim(Source.Lines[AktLine])='' then
       // wenn die nфchste Zeile leer ist, dann f№gen wir einen neuen Paragraphen
       // ein, sonst nur ein <br>
        begin
        // Alle offenen Tags werden geschlosssen
         for loop2:=0 to ReihenFolge.Count-1 do
          case Integer(Reihenfolge[loop2]) of
           1: if fett then s:=s+'</b>';
           2: if kursiv then s:=s+'</i>';
           3: if us then s:=s+'</u>';
           4: s:=s+'</font>';
          end; // case
         fett:=false;
         kursiv:=false;
         us:=false;
         s:=s+'</p>';
         Align:=Source.Paragraph.Alignment;
         case Align of
          taLeftJustify:s:=s+'<p align="left">';
          taRightJustify:s:=s+'<p align="right">';
          taCenter:s:=s+'<p align="center">';
         end;
        end else s:=s+'<br>';

       end; // keine Aufzфhlung
     AktLine:=SendMessage (Source.Handle, EM_LINEFROMCHAR,
                           Source.SelStart, 0);
    end; // neue Zeile

     for loop2:=0 to ReihenFolge.Count-1 do
      case Integer(ReihenFolge[loop2]) of

       1: if fsBold in Style then
            begin
             if not fett then
              begin
               s:=s+'<b>';
               fett:=true;
               ReihenFolge.Move(loop2,0);
             end;
            end else begin
             if fett then
              begin
               s:=s+'</b>';
               fett:=false;
               ReihenFolge.Move(loop2,ReihenFolge.Count-1);
              end;
            end;

          2: if fsItalic in Style then
              begin
               if not kursiv then
                begin
                 s:=s+'<i>';
                 kursiv:=true;
                 ReihenFolge.Move(loop2,0);
                end;
              end else begin
               if kursiv then
                begin
                 s:=s+'</i>';
                 kursiv:=false;
                 ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                end;
              end;

          3: if fsUnderline in Style then
              begin
               if not us then
                begin
                 s:=s+'<u>';
                 us:=true;
                 ReihenFolge.Move(loop2,0);
                end;
               end else begin
                if us then
                 begin
                  s:=s+'</u>';
                  us:=false;
                  ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                 end;
               end;

           4 : if Color<>aktcolor then
               begin
                aktcolor:=color;
                s:=s+'</font><font size="'+IntToStr(aktsize)+'" color="#'+IntToHex(GetRValue(AktColor),2)+IntToHex(GetGValue(AktColor),2)+IntToHex(GetBValue(AktColor),2)+'">';
                ReihenFolge.Move(loop2,0);
              end;

           5: if CalculateSize(Size)<>aktSize then
               begin
                aktsize:=CalculateSize(size);
                s:=s+'</font><font size="'+IntToStr(aktsize)+'">';
                ReihenFolge.Move(loop2,0);
               end;

           6: if Source.Paragraph.Numbering =nsBullet then
               begin
                if not bullet then
                 begin
                  s:=s+'<li>';
                  bullet:=true;
                  ReihenFolge.Move(loop2,0);
                 end;
               end else begin
                if bullet then
                  begin
                   s:=s+'</li>';
                   bullet:=false;
                   ReihenFolge.Move(loop2,ReihenFolge.Count-1);
                 end;
                end;

     end; // case

    end; // with selattributes do


    // jetzt wird erst mal alles gesфubert, was in der HTM-Datei nicht so nett
    // aussehen w№rde
    if source.SelText='"' then
      s:=s+'&quot;'
     else
    if source.SelText='<' then
      s:=s+'&lt;'
     else
    if source.SelText='>' then
      s:=s+'&gt;'
     else
    if source.SelText='ф' then
      s:=s+'&auml;'
     else
    if source.SelText='─' then
      s:=s+'&Auml;'
     else
    if source.SelText='Ў' then
      s:=s+'&ouml;'
     else
    if source.SelText='╓' then
      s:=s+'&Ouml;'
     else
    if source.SelText='№' then
      s:=s+'&uuml;'
     else
    if source.SelText='▄' then
      s:=s+'&Uuml;'
     else
    if source.SelText='▀' then
      s:=s+'&szlig;'
     else
      s:=s+Source.SelText;
  end; // jedes zeichen

   // Zum Abschlu▀ schlie▀en wir die ganzen Tags nochmal
   for loop2:=0 to ReihenFolge.Count-1 do
    case Integer(Reihenfolge[loop2]) of
     1: if fett then s:=s+'</b>';
     2: if kursiv then s:=s+'</i>';
     3: if us then s:=s+'</u>';
     4: s:=s+'</font>';
     6: s:=s+'</li>';
    end; // case

    // der letzte Paragraph wird geschlossen
  s:=s+'</p>';

 // jetzt leerzeichen raus
 for loop:=100 downto 2 do
  begin
   s2:='';
   for loop2:=1 to loop do
    s2:=s2+' ';
   s:=StringReplace(s,s2,'<!--'+IntToStr(loop)+'-->',[rfReplaceAll,rfIgnoreCase]);
  end;
 for loop:=100 downto 2 do
  begin
   s2:='';
   for loop2:=1 to loop do
    s2:=s2+'&nbsp;';
   s:=StringReplace(s,'<!--'+IntToStr(loop)+'-->',s2,[rfReplaceAll,rfIgnoreCase]);
  end;

 // jetzt sind wir fertig
 s:=s+'<p align="center"> Erstellt mit rtf2html - &copy; 2001 by Johannes Tr&auml;nkle - f&uuml;r Delphi-source.de</p></body></html>';
 
 Dest.Lines.Add(s);
 Reihenfolge.free;

 Source.Width:=630;
 Source.Visible:=true;
end;

end.

--------------------

Alex

Дата 29.3.2006, 13:42 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Экс. модератор
Сообщений: 4147
Регистрация: 25.3.2002
Где: Москва

Репутация: 80
Всего: 162

Один из вариантов есть в FAQ http://vingrad.ru/DELPHI-DLP-001093

PS:
Код не проверял

--------------------

Написать можно все - главное четко представлять, что ты хочешь получить в конце.

Snowy

Дата 29.3.2006, 13:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Alex,

Цитата(Snowy @ 29.3.2006, 12:18

)

Код из DRKB вообще непонятно что делает в FAQ.Я понимаю, что он что-то конвертирует. Но никакого отношения к RTF и HTML он не имеет, хотя гордо лежит там именно под этим заголовком.

Alexeis

Дата 29.3.2006, 13:47 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Вот еще модуль для конвертирования

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Snowy

Дата 29.3.2006, 13:59 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Угу. С него я и начал.

Цитата(Snowy @ 29.3.2006, 12:18

)

Нашел на тори 2 решения.Одно хорошее, но нерабочее.

Если конечно доработать напильником...
Но проще свое доделать.
Это решение виснет, когда не находит название фонта.
А, если не виснит, то размеры совершенно дикие.

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »