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 := '
"';
'
<' : result := '
<';
'
>' : result := '
>';
'
ä' : result := '
ä';
'
Ä' : result := '
Ä';
'
ö' : result := '
ö';
'
Ö' : result := '
Ö';
'
ü' : result := '
ü';
'
Ü' : result := '
Ü';
'
ß' : result := '
ß';
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,'
','
',[rfReplaceAll]);
//
// Ergebnis-String in die Ergebnis-StringList hinzufuegen
AStringList.Add(s);
finally
// Stack wieder freigeben
openTags.Free;
end;
end;
Mit freundlichen Grüßen,
Patrick