Program Reshenie;

Uses crt;

Var m:string;

i,k:integer;

begin

clrscr;

write('Введите интересующий Вас месяц: ');

readln(m);

if (m='Январь') or (m='Март') or (m='Май') or (m='Июль') or (m='Август')

or (m='Октябрь') or (m='Декабрь') then k:=31;

if m='Февраль' then k:=28;

if (m='Апрель') or (m='Июнь') or (m='Сентябрь') or (m='Ноябрь') then k:=30;

writeln('В этом месяце ',k,' дней');

writeln('Нажмите Enter');

readln;

end.

Program N2;

Var x,y,r:Real;

begin

write('Введите координату x: ');readln(x);

write('Введите координату y: ');readln(y);

write('Введите радиус r: ');readln®;

if abs(x)<=r then

if abs(y)<=r then

if sqr(x)+sqr(y)<=sqr® then writeln('Точка в окружности')

else writeln('Точка вне окружности');

write('Нажмите Enter');

readln;

end.

Program N1;

Var a,s1,s2,h:Real;

begin

Write('Введите а: ');Readln(a);

s1:=pi*sqr(a); {площадь кгуга}

h:=sqrt(sqr(a)-sqr(a/2)); {высота треугольника}

s2:=a*h/2; {площадь треугольника}

if s1>s2 then

Writeln('Площадь круга больше площади треугольника: ',s1:4:2,'>',s2:4:2)

else if s1
Writeln('Площадь круга меньше площади треугольника: ',s1:4:2,'<',s2:4:2)

else if s1=s2 then

Writeln('Площадь круга равна площади треугольника: ',s1:4:2,'=',s2:4:2);

Write('Нажмите Enter');

Readln;

end.

Program N1;

Var a,s1,s2,h:Real;

begin

Write('Введите а: ');Readln(a);

s1:=pi*sqr(a); {площадь кгуга}

h:=sqrt(sqr(a)-sqr(a/2)); {высота треугольника}

s2:=a*h/2; {площадь треугольника}

if s1>s2 then

Writeln('Площадь круга больше площади треугольника: ',s1:4:2,'>',s2:4:2)

else if s1
Writeln('Площадь круга меньше площади треугольника: ',s1:4:2,'<',s2:4:2)

else if s1=s2 then

Writeln('Площадь круга равна площади треугольника: ',s1:4:2,'=',s2:4:2);

Write('Нажмите Enter');

Readln;

end.

Program N1;

Var a,s1,s2,h:Real;

begin

Write('Введите а: ');Readln(a);

s1:=pi*sqr(a); {площадь кгуга}

h:=sqrt(sqr(a)-sqr(a/2)); {высота треугольника}

s2:=a*h/2; {площадь треугольника}

if s1>s2 then

Writeln('Площадь круга больше площади треугольника: ',s1:4:2,'>',s2:4:2)

else if s1
Writeln('Площадь круга меньше площади треугольника: ',s1:4:2,'<',s2:4:2)

else if s1=s2 then

Writeln('Площадь круга равна площади треугольника: ',s1:4:2,'=',s2:4:2);

Write('Нажмите Enter');

Readln;

end.

Program v16_2;

Var i,n:integer;

f:real;

begin

writeln('Введите количество элементов ряда');

write('N= ');

readln(n);

f:=0;

for i:=1 to n do f:=f+1/i;

writeln('f= ',f:4:2);

end.

Uses Crt, Graph;

Procedure Init;

var GD,GM:Integer;

begin

DetectGraph(GD,GM);

Initgraph(GD,GM,'');

if GraphResult<>Grok then begin

WriteLn(GraphErrorMsg(GD));

If GD=GrFileNotFound then begin

WriteLn('Ошибка инициализации графики...');

end;

WriteLn('Нажмите ввод');

ReadLn;

Halt(1);

end;

end;

Procedure Zastavka;

var x,y:Integer;

begin

x:=GetMaxX;

y:=GetMaxY;

SetFillStyle(10,1);

Bar(0,0,x,y);

settextstyle(1,0,3);

SetColor(4);

outtextxy(240,50,'КГАЦМиЗ');

settextstyle(1,0,2);

SetColor(10);

outtextxy(400,100,'Кафедра ПМиАСУ');

SetColor(11);

settextstyle(1,0,7);

outtextxy(50,180,'Курсовая работа');

outtextxy(51,180,'Курсовая работа');

SetColor(14);

settextstyle(1,0,3);

outtextxy(30,300,'Разработал: Руководитель:');

outtextxy(30,325,'студент гр.МК-99-1 преподаватель');

outtextxy(30,350,'Кучинский Н.В Солопко И.В.');

repeat until keypressed;

end;

Procedure Zadanie;

begin

ClearDevice;

setcolor(9);

settextstyle(1,0,3);

SetFillStyle(10,1);

Bar(0,0,Getmaxx,GetmaxY);

OuttextXY(50,50,'Даны действительные числа a, b, c. Получить:');

OuttextXY(180,150,'max(a,a+b)+max(a,b+c)');

Line(180,190,450,190);

OuttextXY(200,200,'1+max(a+bc,1.15)');

OuttextXY(50,300,'Вычисление max оформить в виде функции.');

repeat until keypressed;

end;

Function max(a,b:real):Real;

begin

if b<=a then max:=a;

if a<=b then max:=b;

end;

Procedure result;

Var a,b,c,s: Real;

begin

CloseGraph;

Write('Введите значение a, a=');

Readln(a);Writeln;

Write('Введите значение b, b=');

Readln(b); Writeln;

Write('Введите значение c, c=');

Readln©;Writeln;Writeln;

s:=(max(a,a+b)+max(a,b+c))/(1+max(a+b*c,1.15));

Write('Результат вычислений ',s:6:3);

repeat until keypressed;

Init;

end;

Procedure Menu;

Label 1,2;

Const m: array[1..4] of string=

('Заставка',

'Задание',

'Решение',

'Выход');

Var k,i: Integer;

Ch:Char;

begin

2:Ch:= readkey;

if ch=#0 then ch:=readkey;

ClearDevice;

SetFillStyle(10,1);

Bar(0,0,Getmaxx,GetmaxY);

Settextstyle(0,0,0);

Outtextxy(120,450,'Клавишами , выберите пункт меню и нажмите Enter');

Settextstyle(1,0,4);k:=1;

1:for i:=1 to 4 do

begin

SetColor(15);

outtextxy(220,50+i*60,m[i]);

outtextxy(221,51+i*60,m[i]);

end;

case k of

1:begin

SetColor(9);

outtextxy(221,51+k*60,m[k]);

end;

2:begin

SetColor(9);

outtextxy(221,51+k*60,m[k]);

end;

3:begin

SetColor(9);

outtextxy(221,51+k*60,m[k]);

end;

4:begin

SetColor(9);

outtextxy(221,51+k*60,m[k]);

end;

end;

repeat

ch:=ReadKey;

if ch=#0 then ch:=ReadKey;

if ch=#72 then begin

if k=1 then k:=4

else k:=k-1;

goto 1

end;

if ch=#80 then begin

if k=4 then k:=1

else k:=k+1;

goto 1

end;

until ch=#13;

case k of

1:begin

Zastavka;

goto 2;

end;

2:Begin

Zadanie;

Goto 2;

end;

3:begin

Result;

goto 2;

end;

4:begin

Closegraph;

end

end

end;



begin

Init;

Zastavka;

Menu;

end.

Program Laba;

Var x,y,m: Real;

begin

Writeln('Лабораторная работа');

Writeln('------------------------------------');

write('Введите x, x= ');

readln(x);

write('Введите y, y= ');

readln(y);

m:=sqrt((sin(x)/cos(x))*sin(y));

writeln;

write('Вычисленное значение m= ',m:4:2);

readln;

end.

Program Tab;

Const a=3.5;

Var x,z,y:real;

begin

x:=1.0;

writeln('--------------------------------');

writeln('| z | x | y |');

writeln('--------------------------------');

repeat

y:=1.0;

repeat

z:=sqrt((1/a)*(x-0.5)*sqr(cos(y/a)));

writeln('| ',z:5:3,' | ',x:4:1,' | ',y:4:1,' |');

y:=y+0.2;

until y>1.5;

x:=x+0.2;

until x>2.2;

writeln('--------------------------------');

write('Нажмите Enter');

readln;

end.

Program Triugolnik;

Uses crt;

Var Xa,Xb,Xc,

Ya,Yb,Yc:integer;

ab,ac,bc,p:real;

begin

Clrscr;

Writeln('Введите координаты точки А:');

write('x= ');readln(xa);

write('y= ');readln(ya);

Writeln('Введите координаты точки B:');

write('x= ');readln(xb);

write('y= ');readln(yb);

Writeln('Введите координаты точки C:');

write('x= ');readln(xc);

write('y= ');readln(yc);

ab:=sqrt(sqr(abs(xa-xb))+sqr(abs(ya-yb)));

ac:=sqrt(sqr(abs(xa-xc))+sqr(abs(ya-yc)));

bc:=sqrt(sqr(abs(xb-xc))+sqr(abs(yb-yc)));

p:=ab+ac+bc;

writeln('Периметр триугольника равен ',p:4:2);

writeln('Для выхода нажмите Enter');

readln;

end.

Program Pascal;

Uses crt;

Var i,j:integer;

s:longint;

begin

clrscr;

s:=1;

writeln('Числа кратные 11 в интервале от 12 до 100:');

for i:=12 to 100 do begin

if i mod 11=0 then begin

writeln(i);

s:=s*i;

end

end;

writeln('Произведение этих чисел: ',s);

write('Нажмите Enter');

readln;

end

Program Turbo;

Uses crt;

Var i,s:integer;

begin

clrscr;

s:=0;

for i:=1 to 100 do begin

if i mod 2=0 then if sqr(i)<=100 then begin

s:=s+1;

writeln(i,' (',sqr(i),')');

end;

end;

writeln('Количество квадратов четных чисел: ',s);

write('Нажмите Enter');

readln;

end.

program pascal;

var s:string;

n,c,c1,i,a:integer;

begin writeln('введите число:');

readln(s);

c:=0;n:=0;

for i:=1 to length(s) do

begin

c1:=c;

if s[i]='I' then c:=1;

if s[i]='V' then c:=5;

if s[i]='X' then c:=10;

if s[i]='L' then c:=50;

if s[i]='C' then c:=100;

if s[i]='D' then c:=500;

if s[i]='M' then c:=1000;

if c>c1 then a:=-2*c1

else a:=0;

n:=n+a+c

end;

writeln('ваше число=',n)

end.

program pascal;

var s:string;

n,c,c1,i,a:integer;

begin writeln('введите число:');

readln(s);

c:=0;n:=0;

for i:=1 to length(s) do

begin

c1:=c;

if s[i]='I' then c:=1;

if s[i]='V' then c:=5;

if s[i]='X' then c:=10;

if s[i]='L' then c:=50;

if s[i]='C' then c:=100;

if s[i]='D' then c:=500;

if s[i]='M' then c:=1000;

if c>c1 then a:=-2*c1

else a:=0;

n:=n+a+c

end;

writeln('ваше число=',n)

end.

program pascal;

var s:string;

n,l,i:integer;

function stepen(x,y:integer):integer;

begin if y>0 then stepen:=stepen(x,y-1)*x

else stepen:=1

end;

Function Transl(A : String) : Integer;

Var L : Byte;

Begin

If A = ''

Then Transl := 0

Else Begin

L := length(A);

Case A[1] Of

'0' : Transl := Transl(Copy(A, 2, L - 1));

'1' : Transl := Stepen(2, L - 1) + Transl(Copy(A, 2, L - 1));

End

End

End;

begin write('введите двоичное число N= ');

readln(s);

writeln('десятеричное число N= ', Transl(S))

end.

Program pascal;

uses crt;

var a:array[1..4] of real;

n:integer;

s: set of 1..4;

begin

clrscr;

writeln('Элементы окружности пронумерованы следующим образом:');

writeln('1-радиус ®,');

writeln('2-диаметр (D),');

writeln('3-длина (L),');

writeln('4-площадь круга(S).');

write('Введите номер элемента окружности: '); readln(n);

write('Введите значение ',n,' элемента окружности: '); readln(a[n]);

case n of

1:begin

a[2]:=2*a[n];

a[3]:=2*pi*a[n];

a[4]:=pi*sqr(a[n]);

end;

2:begin

a[1]:=a[n]/2;

a[3]:=2*pi*a[1];

a[4]:=pi*sqr(a[1]);

end;

3:begin

a[1]:=a[n]/(2*pi);

a[2]:=2*a[1];

a[4]:=pi*sqr(a[1]);

end;

4:begin

a[1]:=sqrt(a[n]/pi);

a[2]:=2*a[1];

a[3]:=pi*sqr(a[1]);

end;

end;

writeln('a[1] -радиус ® = ',a[1]:4:2);

writeln('a[2]-диаметр (D) = ',a[2]:4:2);

writeln('a[3]-длина (L) = ',a[3]:4:2);

writeln('a[4]-площадь круга(S) = ',a[4]:4:2);

write('Нажмите Enter');

readln;

end.

{Составить программу перевода числа из двоичной системы в восьмеричную систему счисления}

const

S:array['0'..'7'] of String[3]=

('000','001','010','011','100','101','110','111');

{массив значений для перевода из двоичной системы в восмеричную}

var

I:Integer;

C:Char;

Si,So:String;

St:String[3];

begin

ReadLn(Si);

while Length(Si) mod 3 <> 0 do Si:='0'+Si;

{ доп. строку влево до длины, кратной 3 }

So:='';

for I:=1 to Length(Si) div 3 do

begin

St:=Copy(Si,3*I-2,3);{копирование по три символа}

{ 3*I-2 дает числа 1,4,7... - нач. позиции троек дв. цифр }

for C:='0' to '7' do if St=S[C] then So:=So+C

{сравниваем с массивом значений для перевода}

{и записываем найденное значение в строку So}

end;

Writeln(So); {Вывод полученного результата}

write('Нажмите Enter');

readln;

end.

Program Pascal;

Const r=1;

Var x,y,f:real;

b:boolean;

begin

write('x= '); readln(x);

write('y= '); readln(y);

b:=false;

if x<=-2 then begin

f:=x+2;

if (f=y) and (y>=0) then b:=true;

end

else if (x>=-2) and (x<=-1) then begin

f:=sqrt(sqr®-sqr(x+1));

if (f=y) and (y>=0) then b:=true;

end

else if (x>=-1) and (x<=1) then begin

f:=1;

if f=y then b:=true;

end

else if (x>=1) and (x<=2) then begin

f:=-2*x+3;

if (f=y) and (y<=1) and (y>=-1) then b:=true;

end

else if x>=2 then begin

f:=-1;

if f=y then b:=true;

end;

if b then writeln('Точка принадлежит кривой')

else writeln('Точка НЕ принадлежит кривой');

write('Нажмите Enter');

readln;

end.

{

Описать процедуру Minmax(A,B),записывающую в переменную A

минимальное из значений A и B , а в переменную B - максимальное

из этих значений . Используя эту процедуру описать

функцию Max(A,B,C) вещественного типа находящую макс из трёх

вещ чисел A,B и C. С помощью этой функции найти max из

наборов (A,B,C), (A,B,D),(A,C,D), если даны числа A , B , C, D

}



Program Pascal;

Var a,b,c,d:real;



procedure minmax(var a,b:real);

Var s:real;

begin

if b>a then begin

s:=a;

a:=b;

b:=s;

end;

end;



function max(a,b,c:real):real;

begin

minmax(a,b);

minmax(a,c);

max:=a;

end;

begin

write('a= ');readln(a);

write('b= ');readln(b);

write('c= ');readln©;

write('d= ');readln©;



Writeln('Результат вычисления: ',max(max(a,b,c),max(a,b,d),max(a,c,d)):4:2);

write('Нажмите Enter');

readln;

end.

Program Pascal;

Var x,y:real;

begin

write('x= '); readln(x);

if (x>=-1) and (x<=1) then y:=0;

if x<-1 then y:=x+1;

if x>1 then y:=x-1;

writeln('y= ',y:4:2);

write('Нажмите Enter');

readln;

end.

Program Pascal;

Uses Crt;

Const h=0.5;

Var k,x:real;

f:real;

begin

Clrscr;

writeln('-----------------------------------');

writeln('| F | X |');

writeln('-----------------------------------');

x:=0;

while x<3.75-h do begin

x:=x+h;

k:=sin(x)/sqr(x);

{$I-}

if k<0 then begin

write('| Функция не определена');

gotoxy(25,wherey);write('| ',x:4:2);

gotoxy(35,wherey);writeln('|');

end

else begin

f:=ln(k)/ln(10);

write('| ',f:4:2);

gotoxy(25,wherey);write('| ',x:4:2);

gotoxy(35,wherey);writeln('|');

end;

end;

writeln('-----------------------------------');

write('Нажмите Enter');

readln;

end.

Program Pascal;

Uses Crt;

Var s,h,d:real;

i:integer;

begin

clrscr;

write('Введите погрешность вычисления D: D= ');readln(d);

s:=0;

i:=0;

repeat

i:=i+1;

h:=1/sqrt((2*i-1)*(2*i));

s:=s+h;

until h
writeln('Сумма ряда: ',s:6:4);

writeln('Количество членов ряда: ',i);

write('Нажмите Enter');

readln;

end.