Программа
CONST LenText=200; {Возможная длина текста}
TYPE TextArray=array [1..LenText] of String; {Тип - массив текста}
PROCEDURE ReadText(var F:text; var T:TextArray); {Процедура чтения файла}
Var i:integer; {Счетчик}
Begin
Reset(F); {Открытие файла для чтения}
for i:=1 to LenText do {Цикл чтения файла}
if EOF(F) {Проверка достижения конца файла}
then T[i]:='' {Сброс строки}
else ReadLn(F,T[i]); {Чтение строки}
Close(F) {Закрытие файла}
End;
PROCEDURE DelEmptyString(var T:TextArray); {Процедура удаления пустых строк, разрывающих текст}
Var i,j,k:byte; {Счетчики строк массива}
Begin
for i:=1 to LenText-1 do {Цикл просмотра массива}
if T[i]='' {Если текущий элемент пуст}
then begin {то}
j:=i+1; {Установка счетчика}
while j<=LenText do {Вывод счетчика на первую непустую строку}
if T[j]=''
then Inc(j)
else Break;
for k:=j to LenText do {Цикл переноса "хвоста" текста}
begin
T[k-j+i]:=T[k]; {Копирование строки "хвоста"}
T[k]:='' {Удаление строки "хвоста"}
end
end
else;
End;
PROCEDURE FormatText(var T:TextArray; StartSpace, LenString:byte);
{Процедура форматирования текста}
Var i, {Счетчик строк массива}
j:byte; {Счетчик символов строки}
Begin
DelEmptyString(T); {Удаление пустых строк, разрывающих текст}
for i:=1 to StartSpace do T[1]:=' '+T[1]; {Добавление отступов красной строки}
for i:=1 to LenText-1 do {Цикл удаления переноса слов}
begin
DelEmptyString(T); {Защита от опустошения строк при переносах слов}
while T[i,Length(T[i])]='-' do {Проверка переноса слова}
begin {Слияние слова:}
Delete(T[i],Length(T[i]),1); {Удаление символа переноса}
j:=1; {Установка счетчика символов}
while (j<Length(T[i+1]))and(T[i+1,j+1]<>' ') do Inc(j); {Вывод счетчика на певый пробел в строке}
Insert(Copy(T[i+1],1,j),T[i],Length(T[i])+1); {Перенос второй части слова в текущую}
Delete(T[i+1],1,j+1); {Удаление второй части слова из следующей строки текста}
DelEmptyString(T); {Защита от опустошения строк при переносах слов}
end
end;
for i:=1 to LenText-1 do {Цикл форматирования}
begin
DelEmptyString(T); {Защита от опустошения строк при переносах слов}
{Перенос частей строк для выравнивания длины текущей строки:}
if Length(T[i])>LenString {Если длина строки превосходит допустимый размер}
then begin {то - усечение строки:}
j:=LenString; {Установка счетчика на последний допустимый символ}
while (j>0)and(T[i,j+1]<>' ') do Dec(j); {Вывод счетчика на ближайший символ предшествующий пробелу}
if j=0 then j:=LenString; {Если пробела нет, то - переопределение
счетчика для усечения строки по ее длине без учета пробелов}
T[i+1]:=Copy(T[i],j+1,Length(T[i])-j)+' '+T[i+1]; {Копирование "хвоста" строки в начало следующей строки}
Delete(T[i],j+1,Length(T[i])-j); {Удаление "хвоста" строки}
if T[i+1,1]=' ' then Delete(T[i+1],1,1); {Удаление пробела из начала строки}
end
else if Length(T[i])<LenString {Если длина строки меньше требуемого размера}
then begin {то - перенос в текущую строку следующих строк или части следующей строки:}
DelEmptyString(T); {Удаление пустых строк}
while (Length(T[i])+Length(T[i+1])+1<LenString)and(T[i+1]<>'') do {Цикл переноса следующих строк целиком}
begin
if T[i+1]='' then Break; {Прерывание цикла, если достигнут конец текста}
T[i]:=T[i]+' '+T[i+1]; {Перенос (копирование) следующей строки в текущую}
T[i+1]:=''; {Удаление следующей строки}
DelEmptyString(T); {Удаление пустых строк}
end;
j:=LenString-Length(T[i])-1; {Установка счетчика символов следующей
строки с учетом количества недостающих символов в текущей}
while (j>0)and(T[i+1,j+1]<>' ') do Dec(j); {Цикл поиска пробела в следующей строке}
if (j>0)and(T[i+1]<>'') {Если возможен перенос слов, то:}
then begin
T[i]:=T[i]+' '+Copy(T[i+1],1,j); {Перенос части следующей строки в текущую}
Delete(T[i+1],1,j+1) {Удаление части следующей строки}
end
else;
end
else;
end
End;
PROCEDURE WriteText(var F:text; var T:TextArray); {Процедура вывода файла}
Var i:integer; {Счетчик}
Begin
Rewrite(F); {Открытие файла для записи}
for i:=1 to LenText do {Цикл записи файла}
if T[i]='' {Проверка достижения конца текста}
then Break {Досрочный выход из цикла}
else WriteLn(F,T[i]); {Вывод строки текста в файл}
Close(F) {Закрытие файла}
End;
PROCEDURE MakeText(var F:text); {Процедура формирования текста}
Var i:word; {Счетчик слов}
_i:string; {"Слово"}
Begin
Randomize; {Инициализация генератора случайных чисел}
Rewrite(F); {Открытие файла для записи}
i:=0; {Начальное определение счетчика}
while (Random(500)>0)and(i<4000) do {Цикл формирования текста}
begin
Str(i,_i); {Преобразование значения счетчика в строку}
while Length(_i)<4 do _i:='0'+_i; {Вытягивание длины слова}
Write(F,_i); {Вывод слова в файл}
{Вывод пробела или дефиса или переноса или обычного конца строки:}
if (i mod 20 =0) or (Random(8)=0)
then if Random(5)=0
then WriteLn(F,'!!-') {При правильной работе, этот перенос не должен быть в результате (только !!)}
else WriteLn(F)
else if Random(5)=0
then Write(F,'!OK!-') {При правильной работе этот дефис должен остаться в результате}
else Write(F,' ');
Inc(i) {Переопределение счетчика}
end;
Close(F) {Закрытие файла}
End;
VAR F_In,F_Out:text; {Файловые указатели на входной и выходной файлы}
T:TextArray; {Массив текста}
StartSpace, LenString:byte;
{Отступ красной строки и требуемая длина строк текста}
BEGIN
Write('Введите отступ красной строки - ');
ReadLn(StartSpace);
Write('Введите длину строки текста - ');
ReadLn(LenString);
Assign(F_In,'049.txt'); {Связывание файловой переменной с именем входного файла}
Assign(F_Out,'049.frt');{Связывание файловой переменной с именем выходного файла}
MakeText(F_In); {Формирование текста}
ReadText(F_In,T); {Чтение текста из файла}
FormatText(T,StartSpace,LenString); {Форматирование текста}
WriteText(F_Out,T); {Вывод текста в файл}
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию