Комментарии: Процедуры и функции: группа Proc

Автор: Наталья

Наталья — Thu, 31 Jan 2019 05:20:27 +0000

//PascalABC.NET
//Proc60. Используя функцию Dist из задания Proc59, описать процедуру
//Heights(xA, yA, xB, yB, xC, yC, hA, hB, hC), находящую высоты hA, hB, hC 
//треугольника ABC (выходные параметры), проведенные соответственно из вершин
//A, B, C (их координаты являются входными параметрами). С помощью этой 
//процедуры найти высоты треугольников ABC, ABD, ACD,если даны координаты 
//точек A, B, C, D.

//uses PT4;
function Leng(xA,yA,xB,yB:real):real;
 begin
 Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));
 end;
 function Perim(xA,yA,xB,yB,xC,yC:real):real;
 begin
  Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);
 end;
  function Area(xA,yA,xB,yB,xC,yC:real):real;
 var p,AB,AC,BC:real;
 begin
  p:=Perim(xA,yA,xB,yB,xC,yC)/2;
  AB:=Leng(xA,yA,xB,yB);
  AC:=Leng(xA,yA,xC,yC);
  BC:=Leng(xB,yB,xC,yC);
  Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));
 end;
 function Dist(xP,yP,xA,yA,xB,yB:real):real;
 begin
 Dist:=2*Area(xP,yP,xA,yA,xB,yB)/Leng(xA,yA,xB,yB);
 end;
 procedure Heights(xA,yA,xB,yB,xC,yC:real; var hA,hB,hC:real);
 begin
 hA:=Dist(xA,yA,xB,yB,xC,yC);
 hB:=Dist(xB,yB,xA,yA,xC,yC);
 hC:=Dist(xC,yC,xA,yA,xB,yB);
 end;
 
 var xA,yA,xB,yB,xC,yC,xD,yD,hA,hB,hC,hD:real;
begin
  //Task('Proc60');
 write('Введите координаты точек A,B,C,D: ');
 read(xA,yA,xB,yB,xC,yC,xD,yD);
 Heights(xA,yA,xB,yB,xC,yC,hA,hB,hC); 
 writeln('Высоты треугольника ABС: hA=',hA:4:2,' hB=',hB:4:2,' hC=',hC:4:2);
 Heights(xA,yA,xB,yB,xD,yD,hA,hB,hD); 
 writeln('Высоты треугольника ABD: hA=',hA:4:2,' hB=',hB:4:2,' hD=',hD:4:2);
 Heights(xA,yA,xC,yC,xD,yD,hA,hC,hD); 
 writeln('Высоты треугольника ACD: hA=',hA:4:2,' hC=',hC:4:2,' hD=',hD:4:2);
end.

//PascalABC.NET

//Proc60. Используя функцию Dist из задания Proc59, описать процедуру

//Heights(xA, yA, xB, yB, xC, yC, hA, hB, hC), находящую высоты hA, hB, hC

//треугольника ABC (выходные параметры), проведенные соответственно из вершин

//A, B, C (их координаты являются входными параметрами). С помощью этой

//процедуры найти высоты треугольников ABC, ABD, ACD,если даны координаты

//точек A, B, C, D.

//uses PT4;

function Leng(xA,yA,xB,yB:real):real;

begin

Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));

end;

function Perim(xA,yA,xB,yB,xC,yC:real):real;

begin

Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);

end;

function Area(xA,yA,xB,yB,xC,yC:real):real;

var p,AB,AC,BC:real;

begin

p:=Perim(xA,yA,xB,yB,xC,yC)/2;

AB:=Leng(xA,yA,xB,yB);

AC:=Leng(xA,yA,xC,yC);

BC:=Leng(xB,yB,xC,yC);

Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));

end;

function Dist(xP,yP,xA,yA,xB,yB:real):real;

begin

Dist:=2*Area(xP,yP,xA,yA,xB,yB)/Leng(xA,yA,xB,yB);

end;

procedure Heights(xA,yA,xB,yB,xC,yC:real; var hA,hB,hC:real);

begin

hA:=Dist(xA,yA,xB,yB,xC,yC);

hB:=Dist(xB,yB,xA,yA,xC,yC);

hC:=Dist(xC,yC,xA,yA,xB,yB);

end;

var xA,yA,xB,yB,xC,yC,xD,yD,hA,hB,hC,hD:real;

begin

//Task('Proc60');

write('Введите координаты точек A,B,C,D: ');

read(xA,yA,xB,yB,xC,yC,xD,yD);

Heights(xA,yA,xB,yB,xC,yC,hA,hB,hC);

writeln('Высоты треугольника ABС: hA=',hA:4:2,' hB=',hB:4:2,' hC=',hC:4:2);

Heights(xA,yA,xB,yB,xD,yD,hA,hB,hD);

writeln('Высоты треугольника ABD: hA=',hA:4:2,' hB=',hB:4:2,' hD=',hD:4:2);

Heights(xA,yA,xC,yC,xD,yD,hA,hC,hD);

writeln('Высоты треугольника ACD: hA=',hA:4:2,' hC=',hC:4:2,' hD=',hD:4:2);

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 05:17:01 +0000

//PascalABC.NET
//Proc59. Используя функции Leng и Area из заданий Proc56 и Proc58, описать
//функцию Dist(xP, yP, xA, yA, xB, yB) вещественного типа, находящую
//расстояние D(P, AB) от точки P до прямой AB по формуле D(P, AB) = 2*SPAB/|AB|,
//где SPAB — площадь треугольника PAB. С помощью этой функции найти расстояния 
//от точки P до прямых AB, AC, BC, если даны координаты точек P, A, B, C.

//uses PT4;
function Leng(xA,yA,xB,yB:real):real;
 begin
 Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));
 end;
 function Perim(xA,yA,xB,yB,xC,yC:real):real;
 begin
  Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);
 end;
  function Area(xA,yA,xB,yB,xC,yC:real):real;
 var p,AB,AC,BC:real;
 begin
  p:=Perim(xA,yA,xB,yB,xC,yC)/2;
  AB:=Leng(xA,yA,xB,yB);
  AC:=Leng(xA,yA,xC,yC);
  BC:=Leng(xB,yB,xC,yC);
  Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));
 end;
 function Dist(xP,yP,xA,yA,xB,yB:real):real;
 begin
 Dist:=2*Area(xP,yP,xA,yA,xB,yB)/Leng(xA,yA,xB,yB);
 end;
 
 var xP,yP,xA,yA,xB,yB,xC,yC:real;
begin
  //Task('Proc59');
 write('Введите координаты точек P,A,B,C: ');
 read(xP,yP,xA,yA,xB,yB,xC,yC);
 writeln('Расстояние от точки P до прямой AB = ',Dist(xP,yP,xA,yA,xB,yB):4:2);
 writeln('Расстояние от точки P до прямой AC = ',Dist(xP,yP,xA,yA,xC,yC):4:2);
 writeln('Расстояние от точки P до прямой BC = ',Dist(xP,yP,xB,yB,xC,yC):4:2);
end.

//PascalABC.NET

//Proc59. Используя функции Leng и Area из заданий Proc56 и Proc58, описать

//функцию Dist(xP, yP, xA, yA, xB, yB) вещественного типа, находящую

//расстояние D(P, AB) от точки P до прямой AB по формуле D(P, AB) = 2*SPAB/|AB|,

//где SPAB — площадь треугольника PAB. С помощью этой функции найти расстояния

//от точки P до прямых AB, AC, BC, если даны координаты точек P, A, B, C.

//uses PT4;

function Leng(xA,yA,xB,yB:real):real;

begin

Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));

end;

function Perim(xA,yA,xB,yB,xC,yC:real):real;

begin

Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);

end;

function Area(xA,yA,xB,yB,xC,yC:real):real;

var p,AB,AC,BC:real;

begin

p:=Perim(xA,yA,xB,yB,xC,yC)/2;

AB:=Leng(xA,yA,xB,yB);

AC:=Leng(xA,yA,xC,yC);

BC:=Leng(xB,yB,xC,yC);

Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));

end;

function Dist(xP,yP,xA,yA,xB,yB:real):real;

begin

Dist:=2*Area(xP,yP,xA,yA,xB,yB)/Leng(xA,yA,xB,yB);

end;

var xP,yP,xA,yA,xB,yB,xC,yC:real;

begin

//Task('Proc59');

write('Введите координаты точек P,A,B,C: ');

read(xP,yP,xA,yA,xB,yB,xC,yC);

writeln('Расстояние от точки P до прямой AB = ',Dist(xP,yP,xA,yA,xB,yB):4:2);

writeln('Расстояние от точки P до прямой AC = ',Dist(xP,yP,xA,yA,xC,yC):4:2);

writeln('Расстояние от точки P до прямой BC = ',Dist(xP,yP,xB,yB,xC,yC):4:2);

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 05:13:59 +0000

//PascalABC.NET
//Proc58. Используя функции Leng и Perim из заданий Proc56 и Proc57, описать
//функцию Area(xA, yA, xB, yB, xC, yC) вещественного типа, находящую
//площадь треугольника ABC по формуле SABC = sqrt(p*(p-|AB|)*(p-|AC|)-(p-|BC|)),
//где p — полупериметр. С помощью этой функции найти площади треугольников
//ABC, ABD, ACD, если даны координаты точек A, B, C, D.

//uses PT4;
 function Leng(xA,yA,xB,yB:real):real;
 begin
  Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));
 end;
 
 function Perim(xA,yA,xB,yB,xC,yC:real):real;
 begin
  Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);
 end;
 
 function Area(xA,yA,xB,yB,xC,yC:real):real;
 var p,AB,AC,BC:real;
 begin
  p:=Perim(xA,yA,xB,yB,xC,yC)/2;
  AB:=Leng(xA,yA,xB,yB);
  AC:=Leng(xA,yA,xC,yC);
  BC:=Leng(xB,yB,xC,yC);
  Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));
 end;
 
 var xA,yA,xB,yB,xC,yC,xD,yD:real;
begin
 //Task('Proc58');
  write('Введите координаты точек A,B,C,D: ');
  read(xA,yA,xB,yB,xC,yC,xD,yD);
  writeln('Площадь треугольника ABС= ',Area(xA,yA,xB,yB,xC,yC):4:2);
  writeln('Площадь треугольника ABD= ',Area(xA,yA,xB,yB,xD,yD):4:2);
  writeln('Площадь треугольника ACD= ',Area(xA,yA,xC,yC,xD,yD):4:2);
end.

//PascalABC.NET

//Proc58. Используя функции Leng и Perim из заданий Proc56 и Proc57, описать

//функцию Area(xA, yA, xB, yB, xC, yC) вещественного типа, находящую

//площадь треугольника ABC по формуле SABC = sqrt(p*(p-|AB|)*(p-|AC|)-(p-|BC|)),

//где p — полупериметр. С помощью этой функции найти площади треугольников

//ABC, ABD, ACD, если даны координаты точек A, B, C, D.

//uses PT4;

function Leng(xA,yA,xB,yB:real):real;

begin

Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));

end;

function Perim(xA,yA,xB,yB,xC,yC:real):real;

begin

Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);

end;

function Area(xA,yA,xB,yB,xC,yC:real):real;

var p,AB,AC,BC:real;

begin

p:=Perim(xA,yA,xB,yB,xC,yC)/2;

AB:=Leng(xA,yA,xB,yB);

AC:=Leng(xA,yA,xC,yC);

BC:=Leng(xB,yB,xC,yC);

Area:=sqrt(p*(p-AB)*(p-AC)*(p-BC));

end;

var xA,yA,xB,yB,xC,yC,xD,yD:real;

begin

//Task('Proc58');

write('Введите координаты точек A,B,C,D: ');

read(xA,yA,xB,yB,xC,yC,xD,yD);

writeln('Площадь треугольника ABС= ',Area(xA,yA,xB,yB,xC,yC):4:2);

writeln('Площадь треугольника ABD= ',Area(xA,yA,xB,yB,xD,yD):4:2);

writeln('Площадь треугольника ACD= ',Area(xA,yA,xC,yC,xD,yD):4:2);

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 05:10:54 +0000

//PascalABC.NET
//Proc57. Используя функцию Leng из задания Proc56, описать функцию
//Perim(xA, yA, xB, yB, xC, yC) вещественного типа, находящую периметр
//треугольника ABC по координатам его вершин (xA, yA, xB, yB, xC, yC —
//вещественные параметры). С помощью этой функции найти периметры
//треугольников ABC, ABD, ACD, если даны координаты точек A, B, C, D.

//uses PT4;
function Leng(xA,yA,xB,yB:real):real;
 begin
 Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));
 end;
 
 function Perim(xA,yA,xB,yB,xC,yC:real):real;
 begin
 Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);
 end;
 
 var xA,yA,xB,yB,xC,yC,xD,yD:real;
begin
 // Task('Proc57');
   write('Введите координаты точек A,B,C,D: ');
   read(xA,yA,xB,yB,xC,yC,xD,yD);
   writeln('Периметр треугольника ABС= ',Perim(xA,yA,xB,yB,xC,yC):4:2);
   writeln('Периметр треугольника ABD= ',Perim(xA,yA,xB,yB,xD,yD):4:2);
   writeln('Периметр треугольника ACD= ',Perim(xA,yA,xC,yC,xD,yD):4:2);
end.

//PascalABC.NET

//Proc57. Используя функцию Leng из задания Proc56, описать функцию

//Perim(xA, yA, xB, yB, xC, yC) вещественного типа, находящую периметр

//треугольника ABC по координатам его вершин (xA, yA, xB, yB, xC, yC —

//вещественные параметры). С помощью этой функции найти периметры

//треугольников ABC, ABD, ACD, если даны координаты точек A, B, C, D.

//uses PT4;

function Leng(xA,yA,xB,yB:real):real;

begin

Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));

end;

function Perim(xA,yA,xB,yB,xC,yC:real):real;

begin

Perim:=Leng(xA,yA,xB,yB)+Leng(xC,yC,xB,yB)+Leng(xC,yC,xA,yA);

end;

var xA,yA,xB,yB,xC,yC,xD,yD:real;

begin

// Task('Proc57');

write('Введите координаты точек A,B,C,D: ');

read(xA,yA,xB,yB,xC,yC,xD,yD);

writeln('Периметр треугольника ABС= ',Perim(xA,yA,xB,yB,xC,yC):4:2);

writeln('Периметр треугольника ABD= ',Perim(xA,yA,xB,yB,xD,yD):4:2);

writeln('Периметр треугольника ACD= ',Perim(xA,yA,xC,yC,xD,yD):4:2);

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 05:07:00 +0000

//PascalABC.NET
//Proc56. Описать функцию Leng(xA, yA, xB, yB) вещественного типа, находящую 
//длину отрезка AB на плоскости по координатам его концов:
//|AB| = sqrt((xA - xB)2 + (yA - yB)2)
//(xA, yA, xB, yB — вещественные параметры). С помощью этой функции
//найти длины отрезков AB, AC, AD, если даны координаты точек A, B, C, D.

//uses PT4;
 function Leng(xA,yA,xB,yB:real):real;
 begin
 Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));
 end;
 
  var xA,yA,xB,yB,xC,yC,xD,yD:real;
begin
 // Task('Proc56');
 write('Введите координаты точек A,B,C,D: ');
 read(xA,yA,xB,yB,xC,yC,xD,yD);
 writeln('Длина AB= ',Leng(xA,yA,xB,yB):4:2);
 writeln('Длина AC= ',Leng(xA,yA,xC,yC):4:2);
 writeln('Длина AD= ',Leng(xA,yA,xD,yD):4:2);
end.

//PascalABC.NET

//Proc56. Описать функцию Leng(xA, yA, xB, yB) вещественного типа, находящую

//длину отрезка AB на плоскости по координатам его концов:

//|AB| = sqrt((xA - xB)2 + (yA - yB)2)

//(xA, yA, xB, yB — вещественные параметры). С помощью этой функции

//найти длины отрезков AB, AC, AD, если даны координаты точек A, B, C, D.

//uses PT4;

function Leng(xA,yA,xB,yB:real):real;

begin

Leng:=sqrt(sqr(xA - xB) + sqr(yA - yB));

end;

var xA,yA,xB,yB,xC,yC,xD,yD:real;

begin

// Task('Proc56');

write('Введите координаты точек A,B,C,D: ');

read(xA,yA,xB,yB,xC,yC,xD,yD);

writeln('Длина AB= ',Leng(xA,yA,xB,yB):4:2);

writeln('Длина AC= ',Leng(xA,yA,xC,yC):4:2);

writeln('Длина AD= ',Leng(xA,yA,xD,yD):4:2);

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 00:52:31 +0000

//Proc55. Используя функцию MonthDays из задания Proc53, описать процедуру
//NextDate(D, M, Y), которая по информации о правильной дате, включающей день D,
//номер месяца M и год Y, определяет следующую дату(параметры целого типа D,M,Y
//являются одновременно входными и выходными). Применить процедуру NextDate
//к трем исходным датам и вывести полученные значения следующих дат.

//uses PT4;
  function IsLeapYear(Y:integer):boolean;
begin
IsLeapYear:=FALSE;
 if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then
 IsLeapYear:=TRUE;
 end;
 
  function MonthDays(M,Y:integer):integer;
 begin
  Case M of
  1,3,5,7,8,10,12:MonthDays:=31;
  2: if IsLeapYear(Y) then  MonthDays:=29 else MonthDays:=28;
  4,6,9,11:MonthDays:=30;
  end;
 end;
 
  procedure PrevDate(var D,M,Y:integer);
 begin
  D:=D+1;
  if D>MonthDays(M,Y) then
  begin
  D:=1;
  M:=M+1;
  if M>12 then M:=1;
  Y:=Y+1;
  end;
 end;
  
 var D,M,Y:integer;
begin
 // Task('Proc55');
 for var i:=1 to 3 do
  begin
  Write('Введите дату (D,M,Y): ');
  Read(D,M,Y);
  PrevDate(D,M,Y);
  Writeln('Следующая дата: ',D,' ',M,' ',Y);
  end;
end.

//Proc55. Используя функцию MonthDays из задания Proc53, описать процедуру

//NextDate(D, M, Y), которая по информации о правильной дате, включающей день D,

//номер месяца M и год Y, определяет следующую дату(параметры целого типа D,M,Y

//являются одновременно входными и выходными). Применить процедуру NextDate

//к трем исходным датам и вывести полученные значения следующих дат.

//uses PT4;

function IsLeapYear(Y:integer):boolean;

begin

IsLeapYear:=FALSE;

if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then

IsLeapYear:=TRUE;

end;

function MonthDays(M,Y:integer):integer;

begin

Case M of

1,3,5,7,8,10,12:MonthDays:=31;

2: if IsLeapYear(Y) then MonthDays:=29 else MonthDays:=28;

4,6,9,11:MonthDays:=30;

end;

procedure PrevDate(var D,M,Y:integer);

begin

D:=D+1;

if D>MonthDays(M,Y) then

begin

D:=1;

M:=M+1;

if M>12 then M:=1;

Y:=Y+1;

end;

var D,M,Y:integer;

begin

// Task('Proc55');

for var i:=1 to 3 do

begin

Write('Введите дату (D,M,Y): ');

Read(D,M,Y);

PrevDate(D,M,Y);

Writeln('Следующая дата: ',D,' ',M,' ',Y);

end;

end.

Автор: Наталья

Наталья — Thu, 31 Jan 2019 00:50:36 +0000

//PascalABC.NET
//Proc54. Используя функцию MonthDays из задания Proc53, описать процедуру
//PrevDate(D, M, Y), которая по информации о правильной дате, включающей день D,
//номер месяца M и год Y, определяет предыдущую дату(параметры целого типа D, M,
//Y являются одновременно входными и выходными). Применить процедуру PrevDate
//к трем исходным датам и вывести полученные значения предыдущих дат.

//uses PT4;
 function IsLeapYear(Y:integer):boolean;
begin
IsLeapYear:=FALSE;
 if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then
 IsLeapYear:=TRUE;
 end;
 
  function MonthDays(M,Y:integer):integer;
 begin
  Case M of
  1,3,5,7,8,10,12:MonthDays:=31;
  2: if IsLeapYear(Y) then  MonthDays:=29 else MonthDays:=28;
  4,6,9,11:MonthDays:=30;
  end;
 end;
 
  procedure PrevDate(var D,M,Y:integer);
 begin
  D:=D-1;
  if D=0 then
  begin
  M:=M-1;
  if M=0 then
   begin
   M:=12;
   Y:=Y-1;
   end;
  D:=MonthDays(M,Y);
  end;
 end;
  
 var D,M,Y:integer;
begin
//  Task('Proc54');
  for var i:=1 to 3 do
  begin
  Write('Введите дату (D,M,Y): ');
  Read(D,M,Y);
  PrevDate(D,M,Y);
  Writeln('Предыдущая дата: ',D,' ',M,' ',Y);
  end;
end.

//PascalABC.NET

//Proc54. Используя функцию MonthDays из задания Proc53, описать процедуру

//PrevDate(D, M, Y), которая по информации о правильной дате, включающей день D,

//номер месяца M и год Y, определяет предыдущую дату(параметры целого типа D, M,

//Y являются одновременно входными и выходными). Применить процедуру PrevDate

//к трем исходным датам и вывести полученные значения предыдущих дат.

//uses PT4;

function IsLeapYear(Y:integer):boolean;

begin

IsLeapYear:=FALSE;

if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then

IsLeapYear:=TRUE;

end;

function MonthDays(M,Y:integer):integer;

begin

Case M of

1,3,5,7,8,10,12:MonthDays:=31;

2: if IsLeapYear(Y) then MonthDays:=29 else MonthDays:=28;

4,6,9,11:MonthDays:=30;

end;

procedure PrevDate(var D,M,Y:integer);

begin

D:=D-1;

if D=0 then

begin

M:=M-1;

if M=0 then

begin

M:=12;

Y:=Y-1;

end;

D:=MonthDays(M,Y);

end;

var D,M,Y:integer;

begin

// Task('Proc54');

for var i:=1 to 3 do

begin

Write('Введите дату (D,M,Y): ');

Read(D,M,Y);

PrevDate(D,M,Y);

Writeln('Предыдущая дата: ',D,' ',M,' ',Y);

end;

end.

Автор: Наталья

Наталья — Wed, 30 Jan 2019 06:13:45 +0000

//PascalABC.NET
//Proc53. Используя функцию IsLeapYear из задания Proc52, описать функцию
//MonthDays(M, Y) целого типа, которая возвращает количество дней для
//M-го месяца года Y (1 <= M <= 12, Y > 0 — целые числа). Вывести значение
//функции MonthDays для данного года Y и месяцев M1, M2, M3.

//uses PT4;
function IsLeapYear(Y:integer):boolean;
begin
IsLeapYear:=FALSE;
 if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then
 IsLeapYear:=TRUE;
 end;
 
 function MonthDays(M,Y:integer):integer;
 begin
 Case M of
 1,3,5,7,8,10,12:MonthDays:=31;
 2: if IsLeapYear(Y) then  MonthDays:=29 else MonthDays:=28;
 4,6,9,11:MonthDays:=30;
 end;
 end;
 var M,Y:integer;
begin
 // Task('Proc53');
 Writeln ('Введите год: ');
 Read(Y);
 Writeln('Введите 3 месяца: ');
 for var i:=1 to 3 do
 begin
 Read(M);
 Writeln('В ',M,' месяце - ',MonthDays(M,Y),' дн.');
 end;
end.

//PascalABC.NET

//Proc53. Используя функцию IsLeapYear из задания Proc52, описать функцию

//MonthDays(M, Y) целого типа, которая возвращает количество дней для

//M-го месяца года Y (1 <= M <= 12, Y > 0 — целые числа). Вывести значение

//функции MonthDays для данного года Y и месяцев M1, M2, M3.

//uses PT4;

function IsLeapYear(Y:integer):boolean;

begin

IsLeapYear:=FALSE;

if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then

IsLeapYear:=TRUE;

end;

function MonthDays(M,Y:integer):integer;

begin

Case M of

1,3,5,7,8,10,12:MonthDays:=31;

2: if IsLeapYear(Y) then MonthDays:=29 else MonthDays:=28;

4,6,9,11:MonthDays:=30;

end;

var M,Y:integer;

begin

// Task('Proc53');

Writeln ('Введите год: ');

Read(Y);

Writeln('Введите 3 месяца: ');

for var i:=1 to 3 do

begin

Read(M);

Writeln('В ',M,' месяце - ',MonthDays(M,Y),' дн.');

end;

end.

Автор: Наталья

Наталья — Wed, 30 Jan 2019 06:11:13 +0000

//PascalABC.NET
//Proc52. Описать функцию IsLeapYear(Y) логического типа, которая возвращает
//TRUE, если год Y (целое положительное число) является високосным, и FALSE 
// в противном случае. Вывести значение функции IsLeapYear для пяти данных 
//значений параметра Y. Високосным считается год, делящийся на 4, за исключением
//тех годов, которые делятся на 100 и не делятся на 400.

//uses PT4;
function IsLeapYear(Y:integer):boolean;
begin
IsLeapYear:=FALSE;
 if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then
 IsLeapYear:=TRUE;
 end;
 
 var Y:integer;
begin
 // Task('Proc52');
Write('Введите пять значений Y: ');
  For var i:=1 to 5 do
  begin
   Read(Y);
   if IsLeapYear(Y) then
   Writeln('Год ',Y,' - високосный') else
   Writeln('Год ',Y,' - невисокосный');
  end;
end.

//PascalABC.NET

//Proc52. Описать функцию IsLeapYear(Y) логического типа, которая возвращает

//TRUE, если год Y (целое положительное число) является високосным, и FALSE

// в противном случае. Вывести значение функции IsLeapYear для пяти данных

//значений параметра Y. Високосным считается год, делящийся на 4, за исключением

//тех годов, которые делятся на 100 и не делятся на 400.

//uses PT4;

function IsLeapYear(Y:integer):boolean;

begin

IsLeapYear:=FALSE;

if (Y mod 4=0)and ((Y mod 100<>0) or ( Y mod 400=0)) then

IsLeapYear:=TRUE;

end;

var Y:integer;

begin

// Task('Proc52');

Write('Введите пять значений Y: ');

For var i:=1 to 5 do

begin

Read(Y);

if IsLeapYear(Y) then

Writeln('Год ',Y,' - високосный') else

Writeln('Год ',Y,' - невисокосный');

end;

end.

Автор: Наталья

Наталья — Tue, 29 Jan 2019 13:37:59 +0000

//PascalABC.NET
//Proc51. Описать процедуру IncTime(H, M, S, T), которая увеличивает на
// T секунд время, заданное в часах H, минутах M и секундах S (H, M и S —
//входные и выходные параметры, T — входной параметр; все параметры —
//целые положительные). Дано время (в часах H, минутах M, секундах S)
//и целое число T. Используя процедуру IncTime, увеличить данное время
//на T секунд и вывести новые значения H, M, S.

//uses PT4;
 procedure IncTime(var H,M,S,T:integer);
  var S1:integer;
begin
S1:=H*3600+M*60+S+T;
 H:=S1 div 3600;
 M:=(S1 mod 3600)div 60;
 S:=(S1 mod 3600)mod 60;
end;
 var H,M,S,T:integer;
begin
 //Task('Proc51');
 Write('Введите время Н,M,S(часы, минуты, секунды)и T в секундах: ');
 Read(H,M,S,T);
 IncTime(H,M,S,T);
 Write('Новое время: H=',H,' M=' ,M,' S=' ,S);
end.

//PascalABC.NET

//Proc51. Описать процедуру IncTime(H, M, S, T), которая увеличивает на

// T секунд время, заданное в часах H, минутах M и секундах S (H, M и S —

//входные и выходные параметры, T — входной параметр; все параметры —

//целые положительные). Дано время (в часах H, минутах M, секундах S)

//и целое число T. Используя процедуру IncTime, увеличить данное время

//на T секунд и вывести новые значения H, M, S.

//uses PT4;

procedure IncTime(var H,M,S,T:integer);

var S1:integer;

begin

S1:=H*3600+M*60+S+T;

H:=S1 div 3600;

M:=(S1 mod 3600)div 60;

S:=(S1 mod 3600)mod 60;

end;

var H,M,S,T:integer;

begin

//Task('Proc51');

Write('Введите время Н,M,S(часы, минуты, секунды)и T в секундах: ');

Read(H,M,S,T);

IncTime(H,M,S,T);

Write('Новое время: H=',H,' M=' ,M,' S=' ,S);

end.