program m1; Uses CRT; type PData = ^TData; TData = record names:array[1..3] of string; {Фамилия, имя, отчество} marks:array[1..3] of integer; {3 оценки} bal:byte; {Дополнительный балл} SB:real; {Средний балл} next:PData; end; Var Head,Tail,P:PData; i,k:integer; N:byte; nn:byte; {--------------------------------------------------------------------------} procedure hello; begin WriteLn(' ************************************************************ '); WriteLn(' * Программа определения проходного балла на заданную * '); WriteLn(' * специальность по результатам вступительных экзаменов * '); WriteLn(' * и формирования списка студентов, * '); WriteLn(' * чей средний балл выше или равен заданному,упорядочивает * '); WriteLn(' * их по фамилиям и размещает в типизированный файл. * '); WriteLn(' ************************************************************ '); WriteLn; end; {--------------------------------------------------------------------------} procedure vvod(var Rec:TData;var n:byte); var s:real;{Сумма 3 оценок} p:integer;{Позиция в строке ввода} error:integer;{код ошибки при преобраз. строки в число} f:text; st:string; bals:string;{Строки,содерж bal} Smarks:array[1..3] of string; Begin {Write('Введите фамилию, имя и отчество: ');} Assign (f,'sot.txt'); reset(f); s:=0; {p:=pos(' ',st); {Р присваивает позицию пробела} while not eof (f) do {Пока не конец файла,делаем} begin for k:=1 to 3 do begin p:=pos(' ',st); rec.names[k]:=copy(st,1,p-1); delete(st,1,p); end; for i:=1 to 3 do {От 1ой до 3ей оценки} begin p:=pos(' ',st); Smarks[i]:=copy(st,1,p-1); {Вырезаем оценку} val(Smarks[i],rec.marks[1],error); {Преобразовываем строку в число} s:=s+rec.marks[i]; {Накапливаем сумму оценок} delete(st,1,p); {Удаляем i оценку из строки} end; bals:=copy(st,1,p-1); val(bals,rec.bal,error); if rec.bal = 0 then {Если дополнительного балла нет} rec.sb:=s/3 else rec.sb:=s+rec.bal/4; n:=n+1; end;{while} close(f); end;{vvod} {ReadLn(Rec.fio); if Rec.Fio<>('*') then begin s:=0; repeat write('Введите количество оценок: '); readln(oc); if (oc>4) or (oc<3) then writeln('Ошибка! кличество оценок < 4 или = 4'); until (oc<=4) and (oc>=3); For i:=1 to oc do begin repeat Write('Введите оценку ',i,': '); ReadLn(Rec.Marks[i]); if rec.marks[i] >4 then writeln('Вы ошиблись. Введена 4-ех бальная система '); until(rec.marks[i]<=4); s:=S+rec.Marks[i]; end; repeat Write('Введите дополнительный балл: '); ReadLn(Rec.Bal); if rec.bal>4 then writeln('Ошибка! Введена 4-ех бальная система. '); until(rec.bal<=4); s:=s+rec.bal; rec.SB:=s/(oc+1); end; end;} {--------------------------------------------------------------------------} procedure add(var nn:byte); var p:PData; begin Head:=nil; Tail:=nil; new(p); vvod(p^,nn); for i:=1 to nn do begin if Head=nil then head:=p else tail^.next:=p; Tail:=p; p^.next:=nil; end;{for} end;{add} {--------------------------------------------------------------------------} procedure prosmotr(var nn:byte); var p:pdata; i,v:byte; begin WriteLn('Результат: '); P:=Head; While P<>nil do for v:=1 to nn do begin for k:=1 to 3 do Write(n,') ',P^.names[k]:3); for i:=1 to 3 do write(p^.marks[i]:3); writeln(p^.bal:3,' ',p^.SB:4:1); P:=P^.next; v:=v+1; end;{while} end;{prosm} {--------------------------------------------------------------------------} Begin{main} clrscr; Hello; add(n); prosmotr(n); readkey; END.