Var s1:ss; p:byte; I:byte;

begin

Pcur:=First;

clrscr;textcolor(red);

writeln('Удаление лишних пробелов');

while Pcur<>nil do

begin

i:=1;

s1:=' ';

repeat

p:=pos(' ',Pcur^.s);

{Находим позицию первого пробела в предложении}

if (p<>0) and (p=i) then

delete(Pcur^.s,p,i) else

{Все подряд стоящие пробелы находим и сразу удаляем, так как они уже лишние}

if (p<>0) and (p<>i) then

begin

s1:=s1+copy(Pcur^.s,i,p);

delete(Pcur^.s,i,p);

{Часть предложения с одним пробелом копируем в буфер и удаляем, чтобы не считать уже сосчитанные пробелы}

end;

until p=0;

s1:=s1+Pcur^.s;

{А теперь нужно добавить ту часть предложения, в которой нет пробелов}

Pcur^.s:=s1;

Pcur:=Pcur^.next;

end;

end;

Procedure MY_list.Outtext;

Var I:integer;

begin

clrscr;

i:=0;

Pcur:=First;

while Pcur<>nil do

begin

writeln(Pcur^.s);

inc(i);

if i=24 then

{ Если количество предложений будет больше, чем число строк на обычном экране}

begin

i:=0;

write('Нажмите любую клавишу');

readkey;

writeln;

end;

Pcur:=Pcur^.next;

end;

writeln('Вывод завершен');

readkey;

end;

end.

unit prg9_1;{Этот модуль включает все вспомогательные действия типа создания файла данных, работа с меню и вывод самого меню на экран }

Interface

uses crt,prg9;

procedure run;

function read_name_file(var f:text):ss;

Implementation

procedure run;

Var Mylt:my_list;

ch:char;

begin

Mylt.init;

repeat

clrscr;

textcolor(white);

writeln(' Выберите действия?');

textcolor(yellow);

write('1. Открыть файл с текстом',#10#13);

write('2. Удалить лишние пробелы',#10#13);

write('3. Вывести текст на экран',#10#13);

write('4. Выход из программы',#10#13);

ch:=readkey;

case ch of

'1': Mylt.loadfile;

'2': begin

clrscr;gotoxy(1,20);

writeln(' Удаление пробелов');

Mylt.Del_prob;readln;

end;

'3': begin

gotoxy(1,3);

Mylt.Outtext;

end;

'4': begin

Mylt.done; exit;

end;

end;

until false;

end;

function read_name_file(var f:text):ss;

var s1:ss;

ch:char;

begin

write(' Введите имя файла ');

readln(s1);

assign(f,s1);

read_name_file:=s1;

rewrite(f);

repeat

Writeln('Введите произвольное предложение');

readln(s1);

writeln(f,s1);

writeln('Есть еще предложения?');

readln(ch);

until ch='n';

close(f);

end; end.