怎样将RTF格式的数据转换成HTML格式或XML格式

Question

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

Answer 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; 

Answer 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; 

Answer 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