Форум: "Основная";
Текущий архив: 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.039 c
