Головна

Пример программы

  1. C) дается пример страны, успешно совместившей в своей правовой системе признаки романо-германский системы права с общим правом.
  2. II. Выпишите из текста примеры употребления в английском предложении неличных форм глагола.
  3. II. Выпишите из текста примеры употребления в английском предложении неличных форм глагола.
  4. IV этап - Запуск программы 1 страница
  5. IV этап - Запуск программы 2 страница
  6. IV этап - Запуск программы 3 страница
  7. IV этап - Запуск программы 4 страница

Program TextFile;

{Сортировка слов в строках текстового файла по алфавиту.

Дан текст. Словом является любая последовательность букв

алфавита. Перед первым словом, после последнего слова и

между словами произвольное число пробелов.

Переставить в каждой строке слова таким образом,

чтобы они были упорядочены по алфавиту.}

Uses Crt; {подключение стандартного модуля Crt}

Procedure Exist(Var nameFT:String);

{Проверка существования файла с указанным именем}

Var

ch:Char;

FT:Text;

Begin

Assign(FT,nameFT);

{$I-} {отключение контроля ошибок ввода-вывода}

Reset(FT);

{$I+} {включение контроля ошибок ввода-вывода}

If IOResult=0

Then Begin

WriteLn('Файл с таким именем уже существует!');

Write('Хотите его уничтожить? Y/N ->');

ReadLn(ch);

If ch In ['n','N','т','Т']

Then Repeat

WriteLn('Введите другое имя:');

ReadLn(nameFT);

Assign(FT,nameFT);

{$I-}

Reset(FT);

{$I+}

If IOResult=0

Then Begin

WriteLn('Файл с таким именем уже существует!');

Write('Хотите его уничтожить? Y/N ->');

ReadLn(ch);

End;

Until (IOResult<>0)Or(ch In['y','Y','н','Н']);

End;

End;

Procedure SozdFT(Const nameFT:String);

{Создание исходного текстового файла}

Var

FT:Text;

i:Byte;

st:String;

Begin

Assign(FT,nameFT);

ReWrite(FT); {открытие файла для записи}

Write('Начинаем ввод. ');

WriteLn('Признак окончания ввода - пустая строка.');

i:=0;

WriteLn('Введите ',i+1,'-ую строку создаваемого файла:');

ReadLn(st); {ввод строки с клавиатуры}

While st<>'' {пока строка не пустая}

Do Begin

WriteLn(FT,st); {запись строки в файл}

Inc(i);

WriteLn('Введите ',i+1,'-ую строку создаваемого файла:');

ReadLn(st);

End;

WriteLn('Введено ',i,' строк');

Close(FT); {закрытие файла}

End;

Procedure ProsmFT(Const nameFT:String);

{Процедура просмотра текстового файла}

Var

st:String;

FT:Text;

Begin

Assign(FT,nameFT);

Reset(FT); {открытие файла для чтения}

If Eof(FT)

Then Begin

Writeln('Файл пуст!');

WriteLn('Нажмите Enter ->');

ReadLn;

Halt;

End;

Writeln(' содержимое файла:'); Writeln;

While Not Eof(FT) {пока не конец файла:}

Do Begin

Readln(FT,st); {чтение строки из файла}

Writeln(st); {вывод строки на экран}

End;

Writeln;

Close(FT); {закрытие файла}

End; {ProsmFT}

Function NovSt(st:String):string;

{Удаление лишних пробелов.

Входное данное: st-строка из слов, разделенных пробелами.

Выходное данное: NovSt-строка без лишних пробелов.}

Var

L,i:Byte;

Begin

L:=Length(st); {текущая длина строки}

i:=1; {текущий номер символа строки}

While i<=L {пока текущий номер в пределах строки}

Do Begin

If st[i]=' ' {если текущий символ - пробел}

Then Begin

If (i=1) Or (i=L) {пробел в начале или конце строки}

Then Delete(st,i,1) {удаление пробела}

Else If (i<L) And (st[i+1]=' ') {второй пробел подряд}

Then Delete(st,i+1,1) {удаление пробела}

Else i:=i+1; {текущий номер символа}

L:=Length(st); {текущая длина строки}

End

Else i:=i+1; {новый текущий номер символа}

End;

NovSt:=st;

End; {UdalLP}

Function Slovo(pn:Byte; st:String):String;

{Выделение очередного слова строки.

Входные данные: pn - начальная позиция слова в строке,

st - строка из слов.

Выходное данное: Slovo - очередное слово строки.}

Var

L,p:Byte;

Begin

L:=Length(st); {длина строки}

p:=pn;

{Цикл поиска очередного пробела}

While (p<=L)And(st[p]<>' ') {Пока не конец слова}

Do p:=p+1; {изменение позиции в строке}

Slovo:=Copy(st,pn,p-pn); {Выделение слова}

End;{Slovo}

Function LexSort(st:String):String;

{Сортировка слов строки по алфавиту.

Входное данное: st-строка из слов, разделенных пробелами.

Выходное данное: LexSort-строка из слов по алфавиту.}

Var

L, {длина строки}

p1,p2:Byte; {начальные позиции соседних слов в строке}

sl1,sl2:String; {соседние слова в строке}

flag:Boolean; {флаг перестановки слов}

Begin

L:=Length(st); {определение длины строки}

Repeat

flag:=FALSE; {отсутствие перестановки}

p1:=1; sl1:=Slovo(p1,st); {первое слово}

While p1+Length(sl1)<L {пока sl1 не последнее}

Do Begin

p2:=p1+Length(sl1)+1;{позиция 2-го слова}

sl2:=Slovo(p2,st); {второе слово}

If sl2<sl1

Then Begin {обмен соседних слов}

Delete(st,p1,p2+Length(sl2)-p1);

Insert(sl2+' '+sl1,st,p1);

p1:=p1+Length(sl2)+1;

flag:=TRUE; {есть перестановка}

End

Else Begin {переход к очередной паре слов}

sl1:=sl2; {новое первое слово}

p1:=p2; {новая позиция слова}

End;

End;

Until Not flag; {до отсутствия перестановок}

LexSort:=st;

End; {LexSort}

Procedure RedaktFT(Const nameF1,nameF2:String);

{Процедура редактирования текстового файла.

Входные данные: F1 - исходный текстовый файл.

Выходные данные: F2 - отредактированный текстовый файл.}

Var

F1,F2:Text;

st:String; {редактируемая строка}

Begin

Assign(F1,nameF1); Assign(F2,nameF2);

Reset(F1); Rewrite(F2); {открытие файлов}

While Not Eof(F1) {пока не конец входного файла}

Do Begin

ReadLn(F1,st); {чтение очередной строки}

st:=NovSt(st); {удаление лишних пробелов}

st:=LexSort(st); {сортировка слов строки по алфавиту}

WriteLn(F2,st); {запись строки в новый файл}

End;

Close(F1); Close(F2); {закрытие файлов}

End; {RedaktFT}

{Основная программа}

Var

nameF1,nameF2:String; {имена текстовых файлов}

Begin

ClrScr; {очистка экрана}

Write('Введите имя исходного файла: ');

ReadLn(nameF1);

Exist(nameF1);

SozdFT(nameF1); {создание исходного файла}

Write('После создания');

ProsmFT(nameF1);

Write('Введите имя результирующего файла: ');

ReadLn(nameF2);

Exist(nameF2);

RedaktFT(nameF1,nameF2); {редактирование файла}

Write('После редактирования');

ProsmFT(nameF2);

ReadLn;

End. {FileText}




  20   21   22   23   24   25   26   27   28   29   30   31   32   33   34   35   Наступна

Суммирование рядов | Пример программы | Обработка одномерных массивов | Пример программы | Обработка двумерных массивов | Пример программы | Методы сортировки | Методы сортировки | Пример №1 | Пример №2 |

© 2016-2022  um.co.ua - учбові матеріали та реферати