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 решения.Одно хорошее, но нерабочее.

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

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

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

Загрузка ...

Брутальный буратина

Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

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

Могу предложыть РичВью там это встроенно + ЕдокЭнджайн к рич вьюву там можно экспортировать хоть в pdf

Guedda

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

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

Загрузка ...

Подрывник

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

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

Это компонент или программа, или класс?
Подробнне, пожалуйста...

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

Ll 2

Snowy

Дата 29.3.2006, 15:21 (ссылка)

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

Загрузка ...

Эксперт

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

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

Пробовали. Впечатляет. Но во-первых платный, во вторых из-за такой кучи возможностей, программа от него тяжелеет хорошо.
Добавлено @ 15:22
Guedda, на торри его найдешь.

Guedda

Дата 29.3.2006, 15:22 (ссылка)

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

Загрузка ...

Подрывник

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

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

Спасибо.

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

Ll 2

Дата 29.3.2006, 15:31 (ссылка)

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

Загрузка ...

Брутальный буратина

Профиль
Группа: Участник Клуба
Сообщений: 3497
Регистрация: 31.3.2002
Где: Лес

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

Snowy, ну первое поправимо в клубе, а второе увы никак.

Это сообщение отредактировал(а) RAdmin - 29.3.2006, 18:10

Snowy

Дата 29.3.2006, 15:36 (ссылка)

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

Загрузка ...

Эксперт

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

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

Нет. Мне всего лишь нужно конвертнуть.
Таскать такой размер из-за этого мне совсем не к чему.
Вот пыхтю, пишу конвертор.
Как напишу - выложу.

Alex

Дата 30.3.2006, 23:07 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Snowy @ 29.3.2006, 14:45)

Alex,

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

)

Все понимаю, в твоих руках изменить его там smile

Это сообщение отредактировал(а) Alex - 30.3.2006, 23:07

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

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

Snowy

Дата 31.3.2006, 09:35 (ссылка)

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

Загрузка ...

Эксперт

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

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

У меня пока получилось такое решение:

Код

function TextToHtml(s: string): string;
const
  sim: array[1..6] of string = ('&lt;', '&gt;','&quot;','&amp;', '<br>', '');
  sims = '<>"&'#13#10;
var i: integer;
begin
  result := '';
  for i := 1 to length(s) do
    if pos(s[i], sims) > 0 then result := result + sim[pos(s[i], sims)]
  else result := result + s[i];
end;

function RtfToHtml(s: string): string;
var
  re: TRichEdit;
  ss: TStringStream;
  f:  string;
  i, sz, cl: integer;
  st: TFontStyles;
  al: TAlignment;
  n:  TNumberingStyle;
  sp: boolean;
begin
  result := '';
  re := TRichEdit.Create(nil); re.WordWrap := false;
  re.Height := 0; re.Parent := Application.MainForm;
  ss := TStringStream.Create(s);
  re.Lines.LoadFromStream(ss);
  ss.Free; s := re.Text;
  f := ''; sz := 0; cl := 0; st := []; sp := false;
  al := taLeftJustify; n := nsNone;
  for i := 1 to Length(s) do
  begin
    re.SelStart := i;
    if (re.CaretPos.X=0) and (re.Lines[re.CaretPos.Y]='') then
      if s[i]=#13 then result:=result+'<br>';
    if re.CaretPos.X = 1 then begin // Paragraph
      if n = nsBullet then result := result+'</li>';
      if (re.Paragraph.Numbering = nsBullet) and (n = nsNone) then
      begin result := result + '<ul>'; n := nsBullet; end;
      if (re.Paragraph.Numbering <> nsBullet) and (n = nsBullet) then
      begin result := result + '</ul>'; n := nsNone; end;
      if n = nsBullet then result := result+'<li>';
      if re.Paragraph.Alignment <> al then begin
        if al <> taLeftJustify then result := result + '</div>';
        al := re.Paragraph.Alignment;
        if al = taRightJustify then result := result + '<div align=right>';
        if al = taCenter then result := result + '<div align=center>';
      end else if n = nsNone then result := result + '<br>';
    end;
    with re.SelAttributes do // Font
      if (f <> Name) or (sz <> Size) or (cl <> Color) or (st <> Style) then
      begin
        if sp then begin result := result + '</span>'; sp := false; end;
        if s[i] > #31 then begin
          f := Name; sz := Size; cl := Color; st := Style;
          result := result + '<span style="{font-family:' + f + ';font-size:' +
          IntToStr(sz) + 'pt;';
          if cl <> 0 then result := result + 'color:#' +
            Format('%.2x%.2x%.2x', [GetRValue(cl), GetGValue(cl), GetBValue(cl)])+
            ';';
          if fsBold in st then result := result + 'font-weight:bold;';
          if fsItalic in st then result := result + 'font-style:italic;';
          if fsUnderline in st then result := result + 'text-decoration:underline;';
          if fsStrikeOut in st then result := result + 'text-decoration:line-through;';
          result := result + '}">'; sp := true;
        end;
      end;
    if s[i] > #31 then result := result + TextToHTML(s[i]);
  end;
  if sp then result := result + '</span>';
  if al <> taLeftJustify then result := result + '</div>';
  if n = nsBullet then result := result + '</ul>';
  re.Free;
end;

Времени нормально протестировать не было.
Если можете, потестите, укажите недостатки.

Yanis

Дата 31.3.2006, 09:58 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Посмотри прикреплённый архив с модулем rtf2html.pas. Даёт прирост 6656 b. Ещё наткнулся на обсуждение. Там же линк на этот модуль.

Это сообщение отредактировал(а) Yanis - 31.3.2006, 09:59

Присоединённый файл ( Кол-во скачиваний: 9 )

rtf2html.zip 8,04 Kb

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

*щёлк*

Snowy

Дата 31.3.2006, 11:09 (ссылка)

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

Загрузка ...

Эксперт

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

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

Yanis, этот модуль тут уже 2 раза упоминался.
Он довольно тупой и при малейшем шаге влево-вправо вешает программу.
Повторюсь - его я пробовал использовать самым первым. Не годится.
Лучше попробуй потестить мой вариант.
Он уже готов и работает.
Нужно только оттестить разные варианты оформления текста и параграфов.
С текстом он справляется отлично. Думаю глюки могут быть с форматированием параграфов.

Yanis

Дата 31.3.2006, 11:13 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата(Snowy @ 31.3.2006, 11:09

)

Yanis, этот модуль тут уже 2 раза упоминался.

Сорри

Цитата(Snowy @ 31.3.2006, 11:09

)

Лучше попробуй потестить мой вариант.

Попробую...
Добавлено @ 11:24
Может неправильно что то делаю, но у меня вообще код кажется не работает. Далаю так:

Код


var
  sl: TStringList;
begin
  if OpenDialog1.Execute then
    RichEdit1.Lines.LoadFromFile(OpenDialog1.FileName);

  sl := TStringList.Create;
  sl.Text := TextToHtml(RichEdit1.Lines.Text);
  sl.SaveToFile('C:\test123.html');
  sl.Free;

После этого в сохранённом файле просто текст, без единого тега smile

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

*щёлк*

Snowy

Дата 31.3.2006, 11:41 (ссылка)

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

Загрузка ...

Эксперт

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

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

Код

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  sl := TStringList.Create;
  sl.LoadFromFile('C:\1.rtf');
  sl.Text := RtfToHtml(sl.Text);
  sl.SaveToFile('C:\1.html');
  sl.Free;
end;

+ я нашел одну маленькую бажечку: После создания RichEdit, нужно сделать re.WordWrap := false;
Уже поправил в исходно посте.

Snowy

Дата 31.3.2006, 13:14 (ссылка)

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

Загрузка ...

Эксперт

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

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

Пофиксил еще одну багу - пропускались пустые строки.
Теперь нужна помощь: как задетектить URL?
Нужно TXT гиперссылки превращать в HTML гиперссылки.
как в тексте определить, что есть гиперссылка, а что нет?

_hunter

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

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

так, как и все делают -- есть в тексте http:// ( https://, ftp:// ) -- ссылка, иначе -- нет.

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

Tempora mutantur, et nos mutamur in illis...

Snowy

Дата 31.3.2006, 13:43 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(_hunter @ 31.3.2006, 13:19

)

тексте http:// ( https://, ftp:// ) -- ссылка, иначе -- нет.

еще mailto.
Видимо так и придется.
А какие еще варианты бывают?

_hunter

Дата 31.3.2006, 13:50 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

еще бывают варианты таскания с собой архива какой-нить dns или определение ссылки на лету ( запрос к dns если два латинских слова разделены точкой, но не разделены пробелом )
но эти способы довольно-таки ресурсоемки и для просторов xUSSR не особо годятся...

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

Tempora mutantur, et nos mutamur in illis...

Yanis

Дата 31.3.2006, 13:51 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Цитата(Snowy @ 31.3.2006, 13:43

)

А какие еще варианты бывают?

Наверное по другому никак. Например в ICQ набираешь http://, то она определяет, что это уже есть ссылка.

Это сообщение отредактировал(а) Yanis - 31.3.2006, 13:52

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

*щёлк*

Snowy

Дата 31.3.2006, 14:02 (ссылка)

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

Загрузка ...

Эксперт

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

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

Еще бывают ссылки вида [email protected]
Их тоже нужно детектить.
Может у кого есть код?

Romikgy

Дата 31.3.2006, 14:32 (ссылка)

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

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

мож по окончаниям типа .ru, .com, .org, .gov, .ua их же будет значительно меньше smile

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

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Snowy

Дата 31.3.2006, 14:35 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(Romikgy @ 31.3.2006, 14:32

)

мож по окончаниям типа .ru, .com, .org, .gov, .ua

Да их сотни. Когда-то я видел код для поиска мылов в строке...
К тому же окончание еще найти нужно. Оно может быть и пробелом и #13 и > и " и еще хрен знает чем.

Snowy

Дата 31.3.2006, 14:55 (ссылка)

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

Загрузка ...

Эксперт

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

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

Наверняка должны быть системная функция детекта урлов.
RichEdit ведь как-то детектит их на системном уровне.
Поковырял SDK, нашел только функцию UrlIs.
Но это уже лучше, чем ничего...

Alexeis

Дата 31.3.2006, 15:20 (ссылка)

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

Загрузка ...

Амеба

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

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

Snowy, ссылки типа [email protected] легко находятся при помощи регулярных выражений

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

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