| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Html to RTF желательно в памяти и целым текстом! [D7, Win2k]

RayRom ©   (2006-10-24 10:45:00) 

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

---

DiamondShark   (2006-10-26 22:28:00) [1]

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

---

Gero   (2006-10-24 18:22:00) [2]

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

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 das erste war kein tag;
     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] = '

---

GrayFace   (2006-10-24 17:51:00) [3]

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

---

RayRom   (2006-10-24 14:16:00) [4]

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

---

Anatoly Podgoretsky   (2006-10-24 14:11:00) [5]

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

---

RayRom   (2006-10-24 14:02:00) [6]

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

---

RayRom   (2006-10-24 10:55:00) [7]

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

---

Ketmar   (2006-10-24 10:47:00) [8]

угу. Word Automation.

---

Наверх