IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> преоборазование текствого файла в Rtf, преоборазование текствого файла в Rtf
pingwin
сообщение 12.11.2004 23:26
Сообщение #1





Группа: Пользователи
Сообщений: 6
Пол: Мужской

Репутация: -  0  +


Кто знает как сделать преоборазование текствого файла в Rtf ? На паскале
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
xds
сообщение 13.11.2004 6:00
Сообщение #2


N337
****

Группа: Пользователи
Сообщений: 737
Пол: Мужской

Репутация: -  26  +


В первом приближении:

Код
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.


Рекомендую почитать спецификацию RTF ("выдрана" с http://www.microsoft.com)


Прикрепленные файлы
Прикрепленный файл  rtf_1.6_spec.zip ( 160.27 килобайт ) Кол-во скачиваний: 172


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
Sifergot
сообщение 18.12.2006 5:07
Сообщение #3





Группа: Пользователи
Сообщений: 1
Пол: Мужской
Реальное имя: Владимир

Репутация: -  0  +


Поясните плиз поточнее, с коментами если не трудно. Читал Немюгина, там про RTF-файл есть...Твоя прога изначально не работала, убрал из нее
begin
 if ParamCount <> 2 then
   begin
     Writeln('Usage: txt2rtf <input.txt> <output.rtf>');
     Halt(1);
   end;
Указал точное местонахождение файлов, все работает, проблема по сути в том, что я понимаю КАК оно работает, но не могу объяснить что именно выполняет какую роль..
Вотъ...


--------------------
МастДай - forever!
Дословно: должен умереть навсегда...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 18.07.2025 14:24
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"