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;