Home » Tutorials » Sonstiges » rtf2html
rtf2html
Schritt 9
Hier ist nochmals die ganze Routine auf einen Blick:
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
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+'</strong>';
2: if kursiv then s:=s+'</em>';
3: if us then s:=s+'</u>';
4: s:=s+'</font>';
end; // case
fett:=false;
kursiv:=false;
us:=false;
s:=s+'
';
end;
end
else begin
if Trim(Source.Lines[AktLine])='' then begin
// wenn die nächste Zeile leer ist, dann fügen wir einen neuen Paragraphen
// ein, sonst nur ein
// Alle offenen Tags werden geschlosssen
for loop2:=0 to ReihenFolge.Count-1 do
case Integer(Reihenfolge[loop2]) of
1: if fett then s:=s+'</strong>';
2: if kursiv then s:=s+'</em>';
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+'
';
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+'<strong>';
fett:=true;
ReihenFolge.Move(loop2,0);
end;
end
else begin
if fett then begin
s:=s+'</strong>';
fett:=false;
ReihenFolge.Move(loop2,ReihenFolge.Count-1);
end;
end;
2: if fsItalic in Style then begin
if not kursiv then begin
s:=s+'<em>';
kursiv:=true;
ReihenFolge.Move(loop2,0);
end;
end
else begin
if kursiv then begin
s:=s+'</em>';
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+'"'
else if source.SelText='<' then
s:=s+'<'
else if source.SelText='>' then
s:=s+'>'
else if source.SelText='ä' then
s:=s+'ä'
else if source.SelText='Ä' then
s:=s+'Ä'
else if source.SelText='ö' then
s:=s+'ö'
else if source.SelText='Ö' then
s:=s+'Ö'
else if source.SelText='ü' then
s:=s+'ü'
else if source.SelText='Ü' then
s:=s+'Ü'
else if source.SelText='ß' then
s:=s+'ß'
else
s:=s+Source.SelText;
end; // jedes zeichen
// Zum Abschluss 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+'</strong>';
2: if kursiv then s:=s+'</em>';
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+' ';
s:=StringReplace(s,'<!--'+IntToStr(loop)+'-->',s2,
[rfReplaceAll,rfIgnoreCase]);
end;
// jetzt sind wir fertig
s:=s+'<p align="center"> Erstellt mit rtf2html -
© 2001 by Johannes Tränkle - für
Delphi-source.de</p></body></html>';
Dest.Lines.Add(s);
Reihenfolge.free;
Source.Width:=630;
Source.Visible:=true;
end;
