Записи

uses crt;
type Tstud=record {тип запись с полями по условию}
           fio:string[20];
           alg:byte;
           gmt:byte;
           fls:byte;
           inf:byte;
           end;
const pr:array[1..4] of string[15]=
      ('алгебра','геометрия','философия','информатика');{массив названий предметов}
var a:array[1..30] of Tstud; {массив записей}
    b:array[1..4] of byte;{массив количеств каждой оценки}
    n,i,max,imax:byte;
begin
clrscr;
repeat
write('Количество студентов, не более 30 n=');
readln(n);
until n in [1..30];
writeln('Введите сведения о ',n,' студентах:');
for i:=1 to n do
 begin
  writeln(' Студент ',i);
  write(' Фамилия И.О.: ');readln(a[i].fio);
  repeat
  write(' Оценка по алгебре: ');readln(a[i].alg);
  until a[i].alg in [2..5];
  repeat
  write(' Оценка по геометрии: ');readln(a[i].gmt);
  until a[i].gmt in [2..5];
  repeat
  write(' Оценка по философии: ');readln(a[i].fls);
  until a[i].fls in [2..5];
  repeat
  write(' Оценка по информатике: ');readln(a[i].inf);
  until a[i].inf in [2..5];
 end;
for i:=1 to 4 do{обнулим массив}
b[i]:=0;
for i:=1 to n do{посчитаем оценки=2}
 begin
  if a[i].alg=2 then b[1]:=b[1]+1;
  if a[i].gmt=2 then b[2]:=b[2]+1;
  if a[i].fls=2 then b[3]:=b[3]+1;
  if a[i].inf=2 then b[4]:=b[4]+1;
 end;
max:=0;imax:=1;
for i:=1 to 4 do
if b[i]>max then
 begin
  max:=b[i];
  imax:=i;{номер предмета, где больше 2}
 end;
write('Больше всего двоек по предмету ',pr[imax]);
readln
end.

uses crt;
type
frac=record
     p:integer; {Числитель дроби}
     q:1..maxint {Знаменатель дроби}
     end;
function Nod(a,b:integer):integer;{нахождение НОД алгоритм Эвклида}
begin
while a <> b do
if a > b then
if a mod b <> 0 then a:=a mod b else a:=b
 else if b mod a <> 0 then b:=b mod a else b:=a;
Nod:=a
end;
procedure Sokr(var a:frac); {Сокращение дроби}
var m,n:integer;
begin
if a.p <> 0 then
   begin
    if a.p < 0 then m:=abs(a.p) else m:=a.p;
   {Совмещение типов, т.к. a.p - integer}
    n:=Nod(m,a.q);
    a.p:=a.p div n;
    a.q:=a.q div n
   end
end;
procedure Summa(a,b:frac; var c:frac); {Сумма дробей}
begin
{Знаменатель дроби}
c.q:=a.q * b.q;
{Числитель дроби}
c.p:=a.p * b.q + b.p * a.q;
Sokr(c)
end;
var d1,d2,d3,s1,s2:frac;
begin
clrscr;
writeln('Введите числитель и знаменатель первой дроби :');
readln(d1.p,d1.q);
writeln('Введите числитель и знаменатель второй дроби :');
readln(d2.p,d2.q);
writeln('Введите числитель и знаменатель третьей дроби :');
readln(d3.p,d3.q);
Summa(d1,d2,s1);
Summa(s1,d3,s2);
write(d1.p,'/',d1.q,'+',d2.p,'/',d2.q,'+',d3.p,'/',d3.q,'=',s2.p,'/',s2.q);
readln
end.

uses crt;
type Point=record
           x,y:real;
           end;
var a,b:Point;
    s:real;
begin
clrscr;
writeln('Введите координаты первой точки:');
readln(a.x,a.y);
writeln('Введите координаты второй точки:');
readln(b.x,b.y);
s:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));
write('Расстояние между точками=',s:0:4);
readln
end.

uses crt;
type Tstud=record {тип запись с полями по условию}
           fio:string[20];
           alg:byte;
           gmt:byte;
           fls:byte;
           inf:byte;
           end;
const pr:array[1..4] of string[15]=
      ('алгебра','геометрия','философия','информатика');{массив названий предметов}
var a:array[1..30] of Tstud; {массив записей}
    b:array[1..4] of byte;{массив количеств каждой оценки}
    n,i,max,imax:byte;
begin
clrscr;
repeat
write('Количество студентов, не более 30 n=');
readln(n);
until n in [1..30];
writeln('Введите сведения о ',n,' студентах:');
for i:=1 to n do
 begin
  writeln(' Студент ',i);
  write(' Фамилия И.О.: ');readln(a[i].fio);
  repeat
  write(' Оценка по алгебре: ');readln(a[i].alg);
  until a[i].alg in [2..5];
  repeat
  write(' Оценка по геометрии: ');readln(a[i].gmt);
  until a[i].gmt in [2..5];
  repeat
  write(' Оценка по философии: ');readln(a[i].fls);
  until a[i].fls in [2..5];
  repeat
  write(' Оценка по информатике: ');readln(a[i].inf);
  until a[i].inf in [2..5];
 end;
for i:=1 to 4 do{обнулим массив}
b[i]:=0;
for i:=1 to n do{посчитаем оценки=2}
 begin
  if a[i].alg=2 then b[1]:=b[1]+1;
  if a[i].gmt=2 then b[2]:=b[2]+1;
  if a[i].fls=2 then b[3]:=b[3]+1;
  if a[i].inf=2 then b[4]:=b[4]+1;
 end;
max:=0;imax:=1;
for i:=1 to 4 do
if b[i]>max then
 begin
  max:=b[i];
  imax:=i;{номер предмета, где больше 2}
 end;
write('Больше всего двоек по предмету ',pr[imax]);
readln
end.
2) Даны три простые дроби, описать их как запись. Найти сумму этих дробей и сократить.
3) Даны координаты двух точек в пространстве, описать их как записи. Найти расстояние между этими точками.
 
И ещё одна задача.
Построить типизированный файл данных, который состоит из записей с такими полями: фамилия автора книги, название книги, год издания. Вывести все названия книг которые изданы после 2000 года и ответить на вопрос, есть ли среди этих книг книги с названием "Информатика"
uses crt;
type knigi=record
           fam:string[20];
           naz:string[30];
           god:word;
           end;
var zp:knigi;{переменная для хранения записей}
    f:file of knigi;{типизированный файл записей}
    i,k:byte;
    c:char;{}
beginсимвол для окончания ввода
clrscr;
assign(f,'knigi');{создаем файл}
rewrite(f);{открываем для зхаписи}
writeln('Введите данные о книгах. Окончание ввода-Esc');
i:=0;
repeat
i:=i+1;
writeln('Книга ',i);
write(' Фамилия автора: ');readln(zp.fam);
write(' Название книги: ');readln(zp.naz);
write(' Год издания:');readln(zp.god);
write(f,zp);{заносим запись в файл}
c:=readkey;{ожидаем нажатия клавиши}
until c=#27;{если Esc-конец ввода}
clrscr;
reset(f);{открываем для чтения}
k:=0;i:=0;
writeln('Книги, изданные после 2000 года:');
while not eof(f) do{пока не конец файла}
 begin
  read(f,zp);{читаем записи}
  if zp.god>2000 then{если после 2000}
   begin
    k:=1;{фиксируем}
    writeln(zp.naz);{выводим название на экран}
   end;
  if zp.naz='Информатика' then i:=1;{фиксируем, если есть Информатика}
 end;
writeln;
if k=0 then writeln('Книг, изданных после 2000 года нет!');
if i=1 then write('Книга с названием "Информатика есть!"')
else write('Книги с названием "Информатика нет!"');
close(f);
readln
end.