Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ преоборазование текствого файла в Rtf
Автор: pingwin 13.11.2004 3:26
Кто знает как сделать преоборазование текствого файла в Rtf ? На паскале
Автор: xds 13.11.2004 10:00
В первом приближении:
Код
program Txt2Rtf;
var
NeedSpace: Boolean;
procedure WriteRTFHeader(var f: Text);
begin
Write(f,
'{\rtf\ansi\ansicp1251\deff0',
'{\fonttbl{\f0\fmodern\charset204 Courier New;}}'
);
end;
procedure WriteRTFFooter(var f: Text);
begin
Write(f, '}');
end;
function WriteRTF(var f: Text; c: Char): String;
procedure WriteKeyword(const Keyword: String);
begin
Write(f, '\', Keyword);
NeedSpace := True;
end;
const
Hex: array[0..15] of Char = '0123456789abcdef';
begin
case c of
#10:
begin
WriteKeyword('line');
Exit;
end;
#9:
begin
WriteKeyword('tab');
Exit;
end;
'\', '{', '}':
Write(f, '\', c);
else
if c > #127 then
Write(f, '\''', Hex[Ord(c) shr 4], Hex[Ord(c) and $F])
else
begin
if NeedSpace then Write(f, ' ');
if c < ' ' then
Write(f, '?')
else
Write(f, c);
end;
end;
NeedSpace := False;
end;
var
fi, fo: Text;
c: Char;
begin
if ParamCount <> 2 then
begin
Writeln('Usage: txt2rtf <input.txt> <output.rtf>');
Halt(1);
end;
Assign(fi, ParamStr(1));
Reset(fi);
Assign(fo, ParamStr(2));
Rewrite(fo);
NeedSpace := False;
WriteRTFHeader(fo);
while not Eof(fi) do
begin
Read(fi, c);
if c <> #13 then WriteRTF(fo, c);
end;
WriteRTFFooter(fo);
Close(fo);
Close(fi);
end.
var
NeedSpace: Boolean;
procedure WriteRTFHeader(var f: Text);
begin
Write(f,
'{\rtf\ansi\ansicp1251\deff0',
'{\fonttbl{\f0\fmodern\charset204 Courier New;}}'
);
end;
procedure WriteRTFFooter(var f: Text);
begin
Write(f, '}');
end;
function WriteRTF(var f: Text; c: Char): String;
procedure WriteKeyword(const Keyword: String);
begin
Write(f, '\', Keyword);
NeedSpace := True;
end;
const
Hex: array[0..15] of Char = '0123456789abcdef';
begin
case c of
#10:
begin
WriteKeyword('line');
Exit;
end;
#9:
begin
WriteKeyword('tab');
Exit;
end;
'\', '{', '}':
Write(f, '\', c);
else
if c > #127 then
Write(f, '\''', Hex[Ord(c) shr 4], Hex[Ord(c) and $F])
else
begin
if NeedSpace then Write(f, ' ');
if c < ' ' then
Write(f, '?')
else
Write(f, c);
end;
end;
NeedSpace := False;
end;
var
fi, fo: Text;
c: Char;
begin
if ParamCount <> 2 then
begin
Writeln('Usage: txt2rtf <input.txt> <output.rtf>');
Halt(1);
end;
Assign(fi, ParamStr(1));
Reset(fi);
Assign(fo, ParamStr(2));
Rewrite(fo);
NeedSpace := False;
WriteRTFHeader(fo);
while not Eof(fi) do
begin
Read(fi, c);
if c <> #13 then WriteRTF(fo, c);
end;
WriteRTFFooter(fo);
Close(fo);
Close(fi);
end.
Рекомендую почитать спецификацию RTF ("выдрана" с http://www.microsoft.com)
Прикрепленные файлы
rtf_1.6_spec.zip ( 160.27 килобайт )
Кол-во скачиваний: 209Автор: Sifergot 18.12.2006 9:07
Поясните плиз поточнее, с коментами если не трудно. Читал Немюгина, там про RTF-файл есть...Твоя прога изначально не работала, убрал из нее
begin
if ParamCount <> 2 then
begin
Writeln('Usage: txt2rtf <input.txt> <output.rtf>');
Halt(1);
end;
Указал точное местонахождение файлов, все работает, проблема по сути в том, что я понимаю КАК оно работает, но не могу объяснить что именно выполняет какую роль..
Вотъ...