Текущий архив: 2006.12.10;
Скачать: CL | DM;

Вниз

Html to RTF желательно в памяти и целым текстом!   Найти похожие ветки 

← →
RayRom ©   (2006-10-24 10:45) [0]

Может кто видел и знает, компоненту такую, нужно чтоб все это происходило в памяти а не с файлами!

---

← →
Ketmar ©   (2006-10-24 10:47) [1]

угу. Word Automation.

---

← →
RayRom ©   (2006-10-24 10:55) [2]

Забыл добавить без всяких СОМ+ и дллок, чистый код интересует!

---

← →
RayRom ©   (2006-10-24 14:02) [3]

Ну если никто не знает, дайте ссылку на нормальное описание формата RTF, желательно с примерами!

---

← →
Anatoly Podgoretsky ©   (2006-10-24 14:11) [4]

Если нормально, то на сайт Микрософт, там самое свежее, а формат постоянно им изменяется, как минимум при смене версии офиса.

---

← →
RayRom ©   (2006-10-24 14:16) [5]

Мне главное чтоб RichTextEdit понимал его!

---

← →
GrayFace ©   (2006-10-24 17:51) [6]

RayRom ©   (24.10.06 14:02) [3]
Ну если никто не знает, дайте ссылку на нормальное описание формата RTF, желательно с примерами!
Нормального не существует, есть очень много неописанных тонкостей, но при создании rtf это, как и то, что он меняется, не важно.

---

← →
Gero ©   (2006-10-24 18:22) [7]

Код не мой, возможно, что нерабочий:

procedure HTMLtoRTF(html: string; var rtf: TRichedit);
var
 i, row: Integer;
 cfont: TFont; { Standard sschrift }
 Tag: string;

 function GetTag(s: string; var i: Integer; var Tag: string): Boolean;
 var
   a_tag: Boolean;
 begin
   GetTag  := False;
   Tag  := "";
   a_tag  := False;

   while i <= Length(s) do
   begin
     Inc(i);
     // es wird nochein tag geoffnet --> 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
         Tag := Tag + s[i];
   end;
 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 =
     (("O", "O"), ("o", "o"), ("A", "A"), ("a", "a"),
     ("U", "U"), ("u", "u"), ("?", "?"), ("<", "<"),
     (">", ">"));
 begin
   // Maximal die nachsten 7 zeichen auf sonderzeichen uberprufen
   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;

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

 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 hinzufugen
 rtf.Lines.Add("");

 cfont := TFont.Create;
 cfont.Assign(rtf.Font);

 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
     GetTag(html, i, 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) = "BR")  then
     begin
       rtf.Lines.Add("");
       Inc(row);
     end

     // unbekanntes tag als text ausgeben
     else
       begin
         rtf.Lines[row]:=RTF.lines[row]+"<"+tag+">";
       end;

     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 ubersetzen
     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;
 cfont.Free;
 rtf.WordWrap := wordwrap;
 FreeFontStack(fo_stk);
end;                      

---

← →
DiamondShark ©   (2006-10-26 22:28) [8]

Описание RTF формата
http://msdn.microsoft.com/library/en-us/dnrtfspec/html/rtfspec.asp

---

Страницы: 1 вся ветка

Текущий архив: 2006.12.10;
Скачать: CL | DM;

Наверх

Память: 0.5 MB
Время: 0.031 c