Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2006.12.10;
Скачать: [xml.tar.bz2];

Вниз

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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.047 c
2-1164561641
Busik
2006-11-26 20:20
2006.12.10
Мой вопрос про изменение атрибутов файлов


15-1163958409
iZEN
2006-11-19 20:46
2006.12.10
Зависает меню Пуск и QuickLaunch.


15-1164005896
vidiv
2006-11-20 09:58
2006.12.10
Вопрос по MSSQL


2-1163994363
Palarm
2006-11-20 06:46
2006.12.10
Линия


3-1159789438
ceval
2006-10-02 15:43
2006.12.10
как в DBText загрузить определенное поле с таблицы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский