bormant писал(а):Проверьте приведённый ниже пример в Delphi/BP/TP, если не сложно...
Проверил, работает. Для себя я тоже применил бы SeekEoln и SeekEof, но в книжке я не касаюсь этих функций, поэтому оставил следующий вариант. Он работает, когда в конце строк с фамилиями нет пробелов, а в конце файла пробелы и пустые строки допускаются.
- Код: Выделить всё
- {$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P+,Q+,R-,S-,T-,V-,X+,Y+}
 
 { P_31_1.pas }
 
 {--- Глобальные переменные ---}
 
 var InFile, OutFile : text;  { входной и выходной файлы }
 Counter: integer;        { счетчик строк в файле }
 
 {----- Функция чтения фамилии -----}
 
 function ReadFam: string;
 var sym: char;
 s : string;
 begin
 s:=''; { очистка накопителя строки }
 { пропуск возможных пустых символов }
 repeat
 Read(InFile, sym)
 until (Ord(sym)>32) or Eof(InFile);
 { чтение последующих символов }
 repeat
 if Ord(sym) > 32 then s:= s+sym;  { добавляем неуправляющий символ }
 if Eoln(InFile) then Break;       { прервать, если конец строки }
 Read(InFile, sym);                { читаем следующий символ }
 until Ord(sym) <= 32;               { вплоть до первого пробела }
 ReadFam:= s;
 end;
 
 {----- Процедура обработки строки -----}
 
 procedure HandleString;
 var N  : integer;    { оценка, прочитанная из файла }
 Cnt: integer;    { количество оценок }
 Sum: integer;    { сумма баллов }
 Rating: Real;    { средний балл }
 Fam: string;     { фамилия }
 
 begin
 Fam:= ReadFam; { читаем фамилию }
 if Length(Fam)>0 then begin  { если фамилия не пуста, обрабатываем }
 { для выравнивания столбцов добавляем пробелы }
 while Length(Fam) < 12 do Fam:= Fam + ' ';
 Sum:=0; Cnt:=0;   { очищаем накопитель и счетчик оценок }
 While not Eoln(InFile) do begin  { пока не конец строки }
 Read(InFile, N);      { читаем оценку в переменную N }
 Sum:= Sum+N;          { накапливаем сумму баллов }
 Cnt:= Cnt+1;          { наращиваем счетчик оценок }
 end;
 if Cnt>0 then begin         { если оценки в четверти были }
 Rating:= Sum / Cnt;      { вычисляем и печатаем ср. балл }
 Writeln(OutFile,Counter:3, Fam:18, Cnt:8, Sum:14, Rating:11:1);
 end else begin            { а если оценок не было }
 Writeln(OutFile, Counter:3, Fam:18,' : Ученик не аттестован');
 end;
 end;
 end;
 
 begin
 Counter:= 0;    { обнуляем счетчик строк }
 { открываем входной файл }
 Assign(InFile,'P_31_1.in');     Reset(InFile);
 { создаем выходной файл }
 Assign(OutFile,'P_31_1.out');   Rewrite(OutFile);
 { записывем "шапку" таблицы }
 Writeln(OutFile, 'Номер    Фамилия       Количество      Сумма      Средний');
 Writeln(OutFile, 'ученика                  оценок        баллов      балл');
 { пока не конец входного файла... }
 while not Eof(InFile) do begin
 Counter:= Counter+1; { наращиваем счетчик строк }
 HandleString;        { обрабатываем строку }
 Readln(InFile);      { сброс признака конца строки }
 end;
 { закрываем оба файла }
 Close(InFile);  Close(OutFile);
 Write('OK'); Readln;
 end.
 
P_31_1.in  (с пустыми строками и пробелами в конце)
- Код: Выделить всё
-   A   3 5 4
 BB
 CCC     5 5 5 5
 
 
 
 
P_31_1.out- Код: Выделить всё
- Номер    Фамилия       Количество      Сумма      Средний
 ученика                  оценок        баллов      балл
 1      A                  3            12        4.0
 2      BB           : Ученик не аттестован
 3      CCC                4            20        5.0
 
Добавлено спустя 56 минут 5 секунд:Re: Ответ на задание 31-Аartischev писал(а):Я ещё попридираюсь к мелочам. 

 
Да пожалуйста, буду рад  
 
 Но с поправкой вашей не соглашусь.
Во-первых, там у вас ошибка: первый вызов Read(F1, N) без проверки на конец файла (а он может быть и пустым).
Во-вторых, лишний ноль появляется из-за пустых строк в конце файла, он не появляется, когда их нет (в конце последней строки находится конец файла).
Вот один из правильных вариантов:
- Код: Выделить всё
- program a_31_a;
 var N, K: integer;
 F1, F2: Text;
 begin
 Assign(F1,'Police.in'); Reset(F1);
 Assign(F2,'Police.out'); Rewrite(F2);
 K:=0;
 while not Eof(F1) do begin
 if {Seek}Eoln(F1)
 then Readln(F1)
 else begin
 Read(F1, N);
 Write(F2, N, ' ');
 K:= (K+1) mod 3;  { K= 0, 1, 2, 0, 1, 2 ...}
 if K=0 then Writeln(F2);
 end
 end;
 Close(F1); Close(F2);
 Write('OK'); Readln
 end.