怎样将RTF格式的数据转换成HTML格式或XML格式,哪里有这样的控件(需要有源码)

解决方案 »

  1.   

    转载aiirii(ari-爱的眼睛)Convert HTML to RTF?  { HTML to RTF by Falk Schulze } procedure HTMLtoRTF(html: string; var rtf: TRichedit); 
    var 
      i, dummy, row: Integer; 
      cfont: TFont; { Standard sschrift } 
      Tag, tagparams: string; 
      params: TStringList;   function GetTag(s: string; var i: Integer; var Tag, tagparams: string): Boolean; 
      var  
        a_tag: Boolean; 
      begin 
        GetTag  := False; 
        Tag  := ''; 
        tagparams := ''; 
        a_tag  := False;     while i <= Length(s) do  
        begin 
          Inc(i); 
          // es wird nochein tag ge&ouml;ffnet --> das erste war kein tag; 
          if s[i] = '<' then  
          begin 
            GetTag := False; 
            Exit; 
          end;       if s[i] = '>' then  
          begin 
            GetTag := True; 
            Exit; 
          end;       if not a_tag then  
          begin 
            if s[i] = ' ' then  
            begin 
              if Tag <> '' then a_tag := True; 
            end  
            else  
              Tag := Tag + s[i]; 
          end  
          else 
            tagparams := tagparams + s[i]; 
        end; 
      end; 
      

  2.   

    procedure GetTagParams(tagparams: string; var params: TStringList); 
      var  
        i: Integer; 
        s: string; 
        gleich: Boolean;     // kontrolliert ob nach dem zeichen bis zum n&auml;chsten zeichen ausser 
        // leerzeichen ein Ist-Gleich-Zeichen kommt 
        function notGleich(s: string; i: Integer): Boolean; 
        begin 
          notGleich := True; 
          while i <= Length(s) do  
          begin 
            Inc(i); 
            if s[i] = '=' then  
            begin 
              notGleich := False; 
              Exit; 
            end  
            else if s[i] <> ' ' then Exit; 
          end; 
        end; 
      begin 
        Params.Clear; 
        s := ''; 
        for i := 1 to Length(tagparams) do  
        begin 
          if (tagparams[i] <> ' ') then  
          begin 
            if tagparams[i] <> '=' then gleich := False; 
            if (tagparams[i] <> '''') and (tagparams[i] <> '"') then s := s + tagparams[i] 
          end  
          else  
          begin 
            if (notGleich(tagparams, i)) and (not Gleich) then  
            begin 
              params.Add(s); 
              s := ''; 
            end  
            else  
              Gleich := True; 
          end; 
        end; 
        params.Add(s); 
      end;   function HtmlToColor(Color: string): TColor; 
      begin 
        Result := StringToColor('$' + Copy(Color, 6, 2) + Copy(Color, 4, 
          2) + Copy(Color, 2, 2)); 
      end;   procedure TransformSpecialChars(var s: string; i: Integer); 
      var  
        c: string; 
        z, z2: Byte; 
        i2: Integer; 
      const  
        nchars = 9; 
        chars: array[1..nchars, 1..2] of string = 
          (('&Ouml;', '&Ouml;'), ('&ouml;', '&ouml;'), ('&Auml;', '&Auml;'), ('&auml;', '&auml;'), 
          ('&Uuml;', '&Uuml;'), ('ü', 'ü'), ('&szlig;', '&szlig;'), ('<', '<'), 
          ('>', '>')); 
      begin 
        // Maximal die n&auml;chsten 7 zeichen auf sonderzeichen überprüfen 
        c  := ''; 
        i2 := i; 
        for z := 1 to 7 do  
        begin 
          c := c + s[i2]; 
          for z2 := 1 to nchars do  
          begin 
            if chars[z2, 1] = c then  
            begin 
              Delete(s, i, Length(c)); 
              Insert(chars[z2, 2], s, i); 
              Exit; 
            end; 
          end; 
          Inc(i2); 
        end; 
      end;   // HtmlTag Schriftgr&ouml;&szlig;e in pdf gr&ouml;&szlig;e umwandeln 
      function CalculateRTFSize(pt: Integer): Integer; 
      begin 
        case pt of 
          1: Result := 6; 
          2: Result := 9; 
          3: Result := 12; 
          4: Result := 15; 
          5: Result := 18; 
          6: Result := 22; 
          else  
            Result := 30; 
        end; 
      end; 
      // Die Font-Stack Funktionen 
    type  
      fontstack = record 
        Font: array[1..100] of tfont; 
        Pos: Byte; 
      end;   procedure CreateFontStack(var s: fontstack); 
      begin 
        s.Pos := 0; 
      end; 
      

  3.   

    procedure PushFontStack(var s: Fontstack; fnt: TFont); 
      begin 
        Inc(s.Pos); 
        s.Font[s.Pos] := TFont.Create; 
        s.Font[s.Pos].Assign(fnt); 
      end;   procedure PopFontStack(var s: Fontstack; var fnt: TFont); 
      begin 
        if (s.Font[s.Pos] <> nil) and (s.Pos > 0) then  
        begin 
          fnt.Assign(s.Font[s.Pos]); 
          // vom stack nehmen 
          s.Font[s.Pos].Free; 
          Dec(s.Pos); 
        end; 
      end;   procedure FreeFontStack(var s: Fontstack); 
      begin 
        while s.Pos > 0 do  
        begin 
          s.Font[s.Pos].Free; 
          Dec(s.Pos); 
        end; 
      end; 
    var  
      fo_cnt: array[1..1000] of tfont; 
      fo_liste: array[1..1000] of Boolean; 
      fo_pos: TStringList; 
      fo_stk: FontStack; 
      wordwrap, liste: Boolean; 
    begin 
      CreateFontStack(fo_Stk);   fo_Pos := TStringList.Create;   rtf.Lines.BeginUpdate; 
      rtf.Lines.Clear; 
      // Das wordwrap vom richedit merken 
      wordwrap  := rtf.wordwrap; 
      rtf.WordWrap := False;   // erste Zeile hinzufügen 
      rtf.Lines.Add(''); 
      Params := TStringList.Create;   cfont := TFont.Create; 
      cfont.Assign(rtf.Font);
      
     
    Top  
     
     回复人: aiirii(ari-爱的眼睛) ( ) 信誉:326  2004-07-27 17:48:00  得分: 0  
     
     
       i := 1; 
      row := 0; 
      Liste := False; 
      // Den eigentlichen Text holen und die Formatiorung merken 
      rtf.selstart := 0; 
      if Length(html) = 0 then Exit; 
      repeat; 
        if html[i] = '<' then  
        begin 
          dummy := i; 
          GetTag(html, i, Tag, tagparams); 
          GetTagParams(tagparams, params);       // Das Font-Tag 
          if Uppercase(Tag) = 'FONT' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            if params.Values['size'] <> '' then 
              cfont.Size := CalculateRTFSize(StrToInt(params.Values['size']));         if params.Values['color'] <> '' then cfont.Color := 
                htmltocolor(params.Values['color']); 
          end  
          else if Uppercase(Tag) = '/FONT' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H1' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 6; 
          end  
          else if Uppercase(Tag) = '/H1' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H2' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 9; 
          end  
          else if Uppercase(Tag) = '/H2' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H3' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 12; 
          end  
          else if Uppercase(Tag) = '/H3' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H4' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 15; 
          end  
          else if Uppercase(Tag) = '/H4' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H5' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 18; 
          end  
          else if Uppercase(Tag) = '/H5' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H6' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 22; 
          end  
          else if Uppercase(Tag) = '/H6' then  popFontstack(fo_stk, cfont)  
          else // Die H-Tags-&Uuml;berschriften 
          if Uppercase(Tag) = 'H7' then  
          begin 
            // Schrift auf fontstack sichern 
            pushFontstack(fo_stk, cfont); 
            cfont.Size := 27; 
          end  
          else if Uppercase(Tag) = '/H7' then  popFontstack(fo_stk, cfont)  
          else // Bold-Tag       if Uppercase(Tag) = 'B' then cfont.Style := cfont.Style + [fsbold]  
          else if Uppercase(Tag) = '/B' then cfont.Style := cfont.Style - [fsbold]  
          else // Italic-Tag       if Uppercase(Tag) = 'I' then cfont.Style := cfont.Style + [fsitalic]  
          else if Uppercase(Tag) = '/I' then cfont.Style := cfont.Style - [fsitalic]  
          else // underline-Tag       if Uppercase(Tag) = 'U' then cfont.Style := cfont.Style + [fsunderline]  
          else if Uppercase(Tag) = '/U' then cfont.Style := cfont.Style - [fsunderline]  
          else // underline-Tag       if Uppercase(Tag) = 'UL' then liste := True  
          else if Uppercase(Tag) = '/UL' then  
          begin 
            liste := False; 
            rtf.Lines.Add(''); 
            Inc(row); 
            rtf.Lines.Add(''); 
            Inc(row); 
          end  
          else // BR - Breakrow tag       if (Uppercase(Tag) = 'BR') or (Uppercase(Tag) = 'LI') then  
          begin 
            rtf.Lines.Add(''); 
            Inc(row); 
          end;       // unbekanntes tag als text ausgeben 
          // else rtf.Lines[row]:=RTF.lines[row]+'<'+tag+' '+tagparams+'>';       fo_pos.Add(IntToStr(rtf.selstart)); 
          fo_cnt[fo_pos.Count] := TFont.Create; 
          fo_cnt[fo_pos.Count].Assign(cfont); 
          fo_liste[fo_pos.Count] := liste; 
        end  
        else  
        begin 
          // Spezialzeichen übersetzen 
          if html[i] = '&' then Transformspecialchars(html, i);       if (Ord(html[i]) <> 13) and (Ord(html[i]) <> 10) then 
            rtf.Lines[row] := RTF.Lines[row] + html[i]; 
        end;     Inc(i);   until i >= Length(html); 
      // dummy eintragen 
      fo_pos.Add('999999');   // Den fertigen Text formatieren 
      for i := 0 to fo_pos.Count - 2 do  
      begin 
        rtf.SelStart := StrToInt(fo_pos[i]); 
        rtf.SelLength := StrToInt(fo_pos[i + 1]) - rtf.SelStart; 
        rtf.SelAttributes.Style := fo_cnt[i + 1].Style; 
        rtf.SelAttributes.Size := fo_cnt[i + 1].Size; 
        rtf.SelAttributes.Color := fo_cnt[i + 1].Color;     // die font wieder freigeben; 
        fo_cnt[i + 1].Free; 
      end;   // die Paragraphen also Listen setzen 
      i := 0; 
      while i <= fo_pos.Count - 2 do  
      begin 
        if fo_liste[i + 1] then  
        begin 
          rtf.SelStart := StrToInt(fo_pos[i + 1]); 
          while fo_liste[i + 1] do Inc(i); 
          rtf.SelLength := StrToInt(fo_pos[i - 1]) - rtf.SelStart; 
          rtf.Paragraph.Numbering := nsBullet; 
        end; 
        Inc(i); 
      end; 
      rtf.Lines.EndUpdate; 
      Params.Free; 
      cfont.Free; 
      rtf.WordWrap := wordwrap; 
      FreeFontStack(fo_stk); 
    end;
      
     
    Top