RTF nach HTML

[patti]

Ich habe nach einer einfachen Methode gesucht, mit Hilfe von Delphi einen RTF-formatierten Text in die entsprechende HTML-Repräsentation umzuwandeln und dabei die wichtigsten Formatierungen (fett, kursiv, unterstrichen sowie Text-Farbe) zu erhalten und Zeilenumbrüche und mehrfache Leerzeichen korrekt zu übernehmen.
Nachdem ich im Internet auf die Schnelle keine einfache und zugleich zufriedenstellende Lösung gefunden habe, habe ich mich an die Arbeit gemacht und folgendes Code-Snippet geschrieben, welches bis jetzt tadellos funktioniert.
Die Routine wandelt zudem die wichtigsten (v.a. deutschsprachigen) Sonderzeichen in die entsprechenden HTML-Repräsentationen um.

In dieser Routine wird jedes Zeichen aus einem RichEdit einzeln betrachtet und mit dem Text-Stil des vorherigen Zeichens verglichen. Bei einer Änderung werden die entsprechenden HTML-Tags in das Ergebnis geschrieben. Um kein geöffnetes Tag zu vergessen und die korrekte Verschachtelung der HTML-Tags zu erreichen, wird ein TStack verwendet.

Hinweis: Bei dem RichEdit sollte die Eigenschaft WordWrap auf true stehen, damit es keine ungewollten <br>-Tags für Zeilenumbrüche im Ergebnis gibt.

Die Routine kann natürlich nach Belieben erweitert oder optimiert werden, aber vielleicht nützt sie ja dem einen oder anderen als Hilfestellung

Delphi-Quellcode:

(*
     RTFToHTML

     by Patrick Kreutzer, http://www.patti-k.de/
     03/2011

     Diese Methode wandelt RTF in HTML um
     Bei dem RichEdit sollte die Eigenschaft WordWrap auf true stehen,
     da ansonsten ungewollte Zeilenumbrueche entstehen
*)
procedure RTFToHTML(const ARichEdit : TRichEdit; const AStringList : TStringList);
var openTags                : TStack; // 1 = bold, 2 = italic, 3 = underline, 4 = span
var bold, italic, underline : boolean;
var textcolor               : TColor;
var line                    : integer;
var l                       : integer;
var i1                      : integer;
var e                       : integer;
var s                       : string;
//<--
     procedure endTag(const ATag : integer);
     begin
          //--
          // Diese innere Methode schliesst evtl. geoeffnete HTML-Tags
          //
          // alle offenen Tags durchgehen
          while (openTags.Count > 0) do
          begin
              // in e steht der Typ des Tags
              // 1 = <b>, 2 = <i>, 3 = <u>, 4 = <span>
              e := Integer(openTags.Pop);
              //
              case e of
              1 : begin
                     s := s + '</b>';
                     //
                     bold := false;
                  end;
              2 : begin
                     s := s + '</i>';
                     //
                     italic := false;
                  end;
              3 : begin
                     s := s + '</u>';
                     //
                     underline := false;
                  end;
              4 : begin
                     s := s + '</span>';
                     //
                     textcolor := clBlack;
                  end;
              end;
              //
              // wenn bestimmtes Tag erreicht, dann abbrechen
              if (e = ATag) then
                Break;
          end;
     end;
     //
     function getHTMLChar(const AChar : char) : string;
     begin
          //--
          // Diese innere Funktion liefert die HTML-Repraesentation
          // zu einem bestimmten Zeichen
          case AChar of
          '"' : result := '&quot;';
          '<' : result := '<';
          '>' : result := '>';
          'ä' : result := '&auml;';
          'Ä' : result := '&Auml;';
          'ö' : result := '&ouml;';
          'Ö' : result := '&Ouml;';
          'ü' : result := '&uuml;';
          'Ü' : result := '&Uuml;';
          'ß' : result := '&szlig;';
          else result := AChar;
          end;
     end;
//-->
begin
     //--
     // Stack fuer geoeffnete HTML-Tags erzeugen
     openTags := TStack.Create;
     //
     try
       // Ergebnis-StringList leeren
       AStringList.Clear;
       //
       // Ergebnis-String initialisieren
       s := '';
       //
       // Standard-Werte setzen
       bold      := false;
       italic    := false;
       underline := false;
       textcolor := ARichEdit.Font.Color;
       //
       line      := 0;
       //
       // Laenge bestimmen
       ARichEdit.SelectAll;
       l := ARichEdit.SelLength;
       //
       // jedes Zeichen im RichEdit durchgehen
       for i1 := 0 to l do
       begin
          // einzelnes Zeichen im RichEdit selektieren
          ARichEdit.SelStart  := i1;
          ARichEdit.SelLength := 1;
          //
          // auf neue Zeile ueberpruefen
          if (line <> SendMessage(ARichEdit.Handle,
                                  EM_LINEFROMCHAR,
                                  ARichEdit.SelStart,
                                  0)) then
          begin
               // alle Tags schliessen
               endTag(-1);
               //
               // HTML-Tag und Zeilenumbruch zum Ergebnis hinzufuegen
               s := s + '<br>' + #13#10;
               //
               // Zeilen-Nr erhoehen
               line := line + 1;
          end;
          //
          // ueberpruefen, ob sich Text-Farbe geaendert hat
          if (ARichEdit.SelAttributes.Color <> textcolor) then
          begin
               // Span-Tag schliessen, wenn bisherige Farbe <> Schwarz war
               if (textcolor <> clBlack) then
               begin
                    endTag(4);
               end;
               //
               // Span-Tag oeffnen, wenn neue Farbe <> Schwarz ist
               if (ARichEdit.SelAttributes.Color <> clBlack) then
               begin
                    // Span-Tag zum Ergebnis hinzufuegen
                    s := s + '<span style="color:#'
                         + IntToHex(GetRValue(ARichEdit.SelAttributes.Color),2)
                         + IntToHex(GetGValue(ARichEdit.SelAttributes.Color),2)
                         + IntToHex(GetBValue(ARichEdit.SelAttributes.Color),2)
                         + ';">';
                    //
                    // Span-Markierung (4) auf den Stack legen
                    openTags.Push(Pointer(4));
               end;
               //
               // aktuelle Text-Farbe merken
               textcolor := ARichEdit.SelAttributes.Color;
          end;
          //
          // ueberpruefen, ob sich Text-Stil "fett" geaendert hat
          if (fsBold in ARichEdit.SelAttributes.Style) <> (bold) then
          begin
               // wenn Text fett WAR, dann Tag schliessen
               if bold then
               begin
                    endTag(1);
               end
               else begin
                    // wenn Text fett WIRD, dann Tag hinzufuegen
                    s := s + '<b>';
                    // Bold-Markierung (1) auf den Stack legen
                    openTags.Push(Pointer(1));
                    //
                    // Zustand merken
                    bold := true;
               end;
          end;
          //
          // ueberpruefen, ob sich Text-Stil "kursiv" geaendert hat
          if (fsItalic in ARichEdit.SelAttributes.Style) <> (italic) then
          begin
               // wenn Text kursiv WAR, dann Tag schliessen
               if italic then
               begin
                    endTag(2);
               end
               else begin
                    // wenn Text kursiv WIRD, dann Tag hinzufuegen
                    s := s + '<i>';
                    // Italic-Markierung (2) auf den Stack legen
                    openTags.Push(Pointer(2));
                    //
                    // Zustand merken
                    italic := true;
               end;
          end;
          //
          // ueberpruefen, ob sich Text-Stil "unterstrichen" geaendert hat
          if (fsUnderline in ARichEdit.SelAttributes.Style) <> (underline) then
          begin
               // wenn Text unterstrichen WAR, dann Tag schliessen
               if underline then
               begin
                    endTag(3);
               end
               else begin
                    // wenn Text unterstrichen WIRD, dann Tag hinzufuegen
                    s := s + '<u>';
                    // Underline-Markierung (3) auf den Stack legen
                    openTags.Push(Pointer(3));
                    //
                    // Zustand merken
                    underline := true;
               end;
          end;
          //
          // Wenn Zeichen, dann HTML-Repraesentation zum Ergebnis hinzufuegen
          if (ARichEdit.SelText <> '') then
            s := s + getHTMLChar(ARichEdit.SelText[1]);
       end;
       //
       // am Schluss noch alle offenen Tags schliessen
       endTag(-1);
       //
       // mehrfache Leerzeichen durch HTML-Repraesentation ersetzen
       s := StringReplace(s,'  ','&nbsp;&nbsp;',[rfReplaceAll]);
       //
       // Ergebnis-String in die Ergebnis-StringList hinzufuegen
       AStringList.Add(s);
     finally
       // Stack wieder freigeben
       openTags.Free;
     end;
end;

Mit freundlichen Grüßen,
Patrick