строки Опции

[Caries]

Стоит следующая задача: дан внешний текстовый файл, нужно взять из него текст и записать в новый файл, причем разбив его типа как в ворде, 25 строк на странице и 80 символов строке.
1.Проблема - как реализовать , чтобы считывалось из текстовго файла по 80 символов и записывалось в массив и далее следующие 80 символов.
2. Нужно ставить символ | чтобы в итоге получилась рамка. Как реализовать чтобы в конце каждой строки скажем после 80 символа ставился такой символ.
спасибо.

[APAL]

А что уже сделано?

[Caries]

Код

program name;
const n= 100;
var t:text;s:string[50];c:char;
m : array[1..n] of string; i:integer; min:string;z:integer;f:integer;
begin
i:=1;
writeln('Enter filename');
readln(s);
assign(t,s);
{$I-}
reset(t);
{$I+}
if ioresult<>0 then
begin writeln('ERROR!!!! File not found!');readln;
end
else
while(not eof(t))and (i<=n) do
begin
readln(t,m[i]);
inc(i);inc(z);
end;
close(t);
writeln('--------------------------------------------------------------------------------');
for i:=1 to z do begin
writeln('|    ',m[i],' |');
end;
end;
end.

пока только это, так как реализовать эти 2 вопрос я не представляю

Сообщение отредактировано: Caries - 28.03.2005 17:21

[volvo]

Для начала, почему не пользуемся поиском... По-моему, вот эта задача довольно похожая... Разбить текст на строки

[Caries]

извиняюсь за невнимательность. по поводу 1 вопроса вроде ясно.
как решить 2 вопрос?

[volvo]

2. Нужно ставить символ | чтобы в итоге получилась рамка. Как реализовать чтобы в конце каждой строки скажем после 80 символа ставился такой символ.

Значит, так ... Если поставить такой символ после 80-го и вывести на печать, то он просто перенесется на следующую строку, т.к. строка на экране содержит максимум 80 символов.

Я бы разбивал не по 80, а по 78, и распечатывал вот так:

Код

Writeln(#179+s+#179);

где s это полученная строка из 78 символов... Таким образом, эта строка будет находиться между двумя символами "|" ...

P.S. Если же нужно сохранить в массиве измененную строку (с символами "|"), то:

Код

s := #179+s+#179;

[Caries]

СТавит, но сразу после строки,а допустим если в строке будет не 78 символов а меньше? например последняя строка?

[volvo]

Тогда проверять длину строки, и дополнять ее пробелами до 78, а потом - выводить, как описано выше...

[Caries]

в принципе можно так. Я думал можно как нить через GOTOXY или подобные функции задать позицию "y" в строке и крутить массив.

[Caries]

Для начала, почему не пользуемся поиском... По-моему, вот эта задача довольно похожая... Разбить текст на строки

Похожая но не та...
Мне нужно желательно читть из текстового файла по 80 символов скажем в массив.
А текстовый файл естественно более 255 смиволов чтобы загнать его в 1 строку и покрамсать по 80 символов в строку... как предложено в примере

Открываем Фаронова:
"Procedure Read([var F:text] v1 [,v2,...,vn]) считывает одно или более значений из текстового файла в одну или болеее переменых."
Значит можно читать с помощбю read и более 1 переменной, но как? или что-то я не так понял.

В общем я здесь мучался пока интернета не было накидал что не так? (пока разбиваю по 50 символов в строку)

Код

program name;
const n= 100;
var t:text;s:string[50];c:char;
m : array[1..n] of string; i:integer; min:string;z:integer;f:integer; mi:string;
begin
i:=1;
writeln('Enter filename');
readln(s);
assign(t,s);
{$I-}
reset(t);
{$I+}
if ioresult<>0 then
begin writeln('ERROR!!!! File not found!');readln;
end
else
while(not eof(t))and (i<=n) do
begin
readln(t,m[i]);
inc(i);inc(z);
end;
rewrite(t);

for i:=1 to z do begin
if length(m[i]) < 50 then begin if length (m[i+1]) >50 then begin
m[i]:=m[i] + copy( m[i+1], 0, 50-length(m[i]));delete( m[i+1], 0 ,50-length(m[i])); end
else m[i]:=m[i]+m[i+1];m[i+1]:=''; end;
if length( m[i]) > 50 then begin m[i+1]:= copy(m[i],50,length(m[i])-50);delete(m[i],50,length(m[i])-50);end;
end;

writeln(t,'----------------------------------------------------');
for i:=1 to z do begin
writeln(t,'|',m[i],'|');
if( i mod 25) = 0 then begin
writeln(t,'----------------------------------------------------');
writeln(t,z);
writeln(t,'----------------------------------------------------');
writeln;
writeln;writeln;
writeln(t,'----------------------------------------------------');
close(t);
end;


end;
end.

[volvo]

Ну и зачем такие сложности? Все проще гораздо:

Код

type arrStr = array[1 .. 100] of string[80];
var
 s: arrStr;
 f: text;
begin
 { открываешь файл, и обрабатываешь ошибки }

 i := 1; s[i] := ''; len := 0; { начинаешь заполнять массив строк с первой }
 while not eof(f) do begin
   read(f, ch);
   { если длина превысила 80 символов, или встретился перевод строки }
   if (ch = #13) or (ch = #10) or (len > 80) then begin
     { переходим на след. элемент массива строк }
     inc(i);
     if len > 80 then s[i] := ch else s[i] := '';
     len := 1; { длина снова = 1 }
   end
   { иначе просто добавить символ к текущей строке и увеличить ее длину }
   else begin
       s[i] := s[i] + ch; inc(len)
   end
 end;

 { вот тут все символы из файла будут считаны в строки длиной
не более 80 символов и занесены в массив s }
end.

[Caries]

Небольшой трабл выводит
строки и после каждой ставляет пустую....
Как избавиться?

Сообщение отредактировано: Caries - 15.04.2005 21:29

[volvo]

Замени основной цикл:

  while not eof(f) do begin
   read(f, ch);
   { если длина превысила 80 символов, или встретился перевод строки }
   if (ch = #13) or (len > 80) then begin
     { переходим на след. элемент массива строк }
     inc(i);
     if len > 80 then s[i] := ch
     else begin
       s[i] := ''; read(f, ch)
     end;
     len := 1; { длина снова = 1 }
   end
   { иначе просто добавить символ к текущей строке и увеличить ее длину }
   else begin
       s[i] := s[i] + ch; inc(len)
   end
 end;

[Caries]

я немного подругому писал

Код

while(not eof(t))and (i<=n) do
begin
read(t,ch); if (ch=#13) or (ch=#10) or (length(m[i]) >80) then
begin
if length( m[i])<80 then begin
d:=81-length(m[i]);(дополняю строку пустыми символами до 80, чтоб сохранить рамку)
for f:=1 to d do
m[i]:=m[i] + ' ';
end;m[i]:=m[i] + ch;
inc(i);m[i]:='' end else m[i]:=m[i] + ch;
end;

выводит вконце кажой строки значок ٱ и вставлет лишнюю рустую строку...
Что у меня не так.

Сообщение отредактировано: Caries - 17.04.2005 19:10

[volvo]

Ну я же тебе уже говорил, что произойдет:

Значит, так ... Если поставить такой символ после 80-го и вывести на печать, то он просто перенесется на следующую строку, т.к. строка на экране содержит максимум 80 символов.

Я бы разбивал не по 80, а по 78 ...

Ничего не напоминает?

[Caries]

Полностью код проги того что уже сделано(хоть и коряво ;))

Код

program name;
const n= 100;
var t:text;s:string[50];
m : array[1..n] of string; i:integer; min:string;z,d,l:integer;f,c:integer; mi:string;ch:char;
begin
i:=1;l:=1;
m[i]:='';
writeln('Enter filename');
readln(s);
assign(t,s);
{$I-}
reset(t);
{$I+}
if ioresult<>0 then
begin writeln('ERROR!!!! File not found!');readln;
end
else
while(not eof(t))and (i<=n) do
begin
read(t,ch); if (ch=#13) or (ch=#10) or (length(m[i]) >80) then
begin
if (length( m[i])<80) or (ch=#10) then begin
d:=81-length(m[i]);
for f:=1 to d do
m[i]:=m[i] + ' ';
end;

inc(i);m[i]:='';read(t,ch) end else m[i]:=m[i] + ch;
end;
m[i]:='';
rewrite(t);
writeln(t,'------------------------------------------------------------------------------------');
for z:=1 to i do begin
writeln(t,'|',m[z],' |');inc(c);
if (( z mod 25) = 0) or ( i= z) then
begin
writeln(t,'------------------------------------------------------------------------------------');
writeln(t,'| Strok in List ',c,'| List ',l);l:=l+1;
writeln(t,'------------------------------------------------------------------------------------');
writeln;

Все нормально, рамка ровно. но жрет теперь символы ну т.е если строка если больше 80 то он следубщий символ теряет...
Кстати а нужно учесть , символ конца файла будет выводиться , его тоже нужно учесть?

Ну я же тебе уже говорил, что произойдет:
Я бы разбивал не по 80, а по 78

т.е мне перебить длину на 78?

Сообщение отредактировано: Caries - 18.04.2005 21:36

[Caries]

Блин мне через неделю уже сдавать (
Вот окончательный вариант. НО жерт последний символ. Помогите....

program kursach;
uses crt,dos;
const n= 100;
var
t_in,t_out:text;{Исходный и форматированный файлы}
f_in,f_out:string;{Имена}
m : array[1..n] of string; i:integer;

{Анализируем вводимые данные.
 Если нажат ESC выходим из программы}
function inp_name:string;
var
bh:char;
n:byte;
ins:string;
begin
   ins:='';
   n:=0;
   bh:=readkey;
   repeat
    if ord(bh)=27
      then halt;
    if (ord(bh)=8)and(n>0)
      then begin
           gotoxy(wherex-1,wherey);
           write(' ');
           dec(n);
           ins:=copy(ins,1,length(ins)-1);
           gotoxy(wherex-1,wherey)
           end;
    if ord(bh)in[32..126]
      then begin
           inc(n);
           ins:=ins+bh;
           write(bh)
           end;
    bh:=readkey
    until ord(bh)=13;
    writeln;
    inp_name:=ins
end;


{Инициализируем файл.
 Проверяем существование.
 Спрашиваем путь}
procedure init;
var
exist:boolean;rec_ord:byte;

begin
writeln('Укажите путь к исходному файлу:');
write('=>');
f_in:=inp_name;

 repeat
  assign(t_in,f_in);
    {$I-}
     reset(t_in);          {проверка существования}
     exist:=IOResult=0;
    {$I+}
     if not exist
       then begin
             writeln('Ошибка!Неправильно Указан' + 
  ' путь к иcходному файлу или его просто не существует');
             writeln('Попpобуйте еще раз(Esc - выход)');
             write('=>');
             f_in:=inp_name;

             end;
 until exist;
 exist:=false;
  repeat
     writeln('В какой файл записать отформатированный текст?');
     write('=>');
     readln(f_out);
     if f_in = f_out
       then begin
            writeln('Вы действительно хотите перезаписать файл?');
            writeln('0-Yes 1-No');
            readln(rec_ord);
     if rec_ord= 0 then exist:=true else exist:=false;end else exist:=true;

  until exist;
end;

procedure formats;{Форматируем текст}
var ch:char;

begin
 while(not eof(t_in))and (i<=n) do
    begin
     read(t_in,ch);            {Считываем посимвольно данные из файла}
     if (ch=#13) or (ch=#10) then
{Если встречается перенос строки или длина
строки становится больше значения, записываем
в сл. элемент массива}
       begin
        while length(m[i])<81  do
         begin
          m[i]:=m[i] + ' ';
         end;
        read(t_in,ch);
       end;
     if (length(m[i]) >80) then
        begin
         inc(i);
         m[i]:='';
        end
     else m[i]:=m[i]+ch;
    end;
 while length(m[i])<81  do
   begin
    m[i]:=m[i] + ' ';
   end;
 writeln;
 writeln('Файл успешно отформатирован и записан: ', f_out);
 readln;
end;


procedure ends;{Записываем отфoрматированный текст в файл}
var c,z,l:integer;

begin
 c:=0;
 l:=1;
 assign(t_out,f_out);
 rewrite(t_out);
 writeln(t_out,
'------------------------------------------------------------------------------------');
 for z:=1 to i do begin
  writeln(t_out,'|',m[z],' |');inc( c );
   if (( z mod 25) = 0) or ( i= z) then
    begin
     writeln(t_out,
'------------------------------------------------------------------------------------');
     writeln(t_out,'| Strok in List ',c,'| List ',l);l:=l+1;
     writeln(t_out,
'------------------------------------------------------------------------------------');
     writeln;
     writeln;writeln;
     writeln(t_out,
'------------------------------------------------------------------------------------');
     c:=0;
    end;
  end;
 close(t_in);
 close(t_out);
end;
begin
 clrscr;
 writeln('===============================');
 writeln('Программа Форматирование текста');
 writeln('===============================');
 writeln;
 i:=1;
 init;
 formats;
 ends; {BCE}
 end.

[volvo]

Вот окончательный вариант. НО жерт последний символ. Помогите....

Проверяй в пошаговом режиме (F7), и исправляй... Откуда можно узнать, где именно это происходит без отладки программы?

[Caries]

Я так чувствую в процедуре Formats. Найти не могу...

[volvo]

Я бы переписал Formats вот так:

procedure formats;{Форматируем текст}
var ch:char;
begin
while (not eof(t_in)) and (i <= n) do begin
  read(t_in, ch);
  if (ch = #13) or (ch = #10) then
    while length(m[i]) < 78 do m[i] := m[i] + #32
  else
    if length(m[i]) < 78 then begin
      m[i] := m[i] + ch
    end
    else begin
      inc(i);
      m[i] := ch; { <--- Здесь терялся символ }
    end;
end;

writeln;
writeln('Файл успешно отформатирован и записан: ', f_out);
readln;
end;