Файл: Сборник-задач-на-Языке-Turbo-Pascal.doc

Uses Crt;

var

a, b. с, d : Real;

function max2(x. у : Real.) : Real;

begin

if x > у then max2 := x else max2 := y;

end;

Begin

CIrScr;

write('Введите четыре числа:');

readln(a, b. с, d);

writeln('Большее из ‘, a:10:5, b;10;5, c;10;5, d:10;5, ‘ = ‘,max2(max2(a, b), max2(c,d));10;5;

readln;

End.

Программа вычисления площади n-угольника.

Рrogramarea;

UsesCrt;

constn= 4;

var

х, у : array[1..n] of Real;

i : Word;

su, pi : Real;

functionlength(nl, n2 : Word) : Real;

begin

length := Sqrt(sqr(x[nl] - x[n2]) + sqr(y[nl] - y[n2]))

end; {length}

procedurespace(nl, n2, n3 : Word; var pi : Real);

var

a, b, c, p: Real;

begin

a := length(nl, n2);

b := length(n2, n3);

с := length(nl, n3);

p:= (а +b+ с) / 2;

pi := Sqrt(p * (p - a) * (p - b) *(P - c));

end; {space}

Begin

Clrscr;

write('Введите координаты 1-й и 2-й вершин ');

readln(x[l] , у[1], х[2] , у[2]);

i := 2;

su := 0;

repeat

i := i + 1; {Подсчет вершин}

write('Введите координаты ', i, '-и вершины');

readln(x[i] , у[I]) ;

space(l, i - 1, i, pi);

su := su + pi;

until i = n;

writeln(‘Площадь = ', su:10:5);

readln;

End.

Составить программу перевода десятичного числа в двоичное.

Program perevod;

Uses Crt;

var a : longint;

function DEC_BIN(x:longint):string;

const digits:array [0..1] of char = ('0','1');

var res:string; d:0..1;

begin

res:='';

while (x<>0) do

begin

d:=x mod 2; res:=digits[d]+res;

x:=x div 2;

end;

DEC_BIN:=res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( DEC_BIN(a) );

readln;

Еnd.

Составить программу перевода двоичного числа в десятичное.

Program perevod2;

Uses Crt;

var a : string;

function BINDEC(x: string): longint;

const digits: array [0..1] of char = ('0','1');

var res, ves: longint;

i, j: byte;

begin

res:=0; ves:=1;

for i:=length(x) downto 1 do begin

j:=0;

while (digits[j]<>x[i]) do inc(j);

res:=res+ves*j;

ves:=ves*2;

end;

BINDEC:= res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( BINDEC(a) );

readln;

Еnd.

Программа перевода десятичного числа в шестнадцатеричное.

Program perevod3;

Uses Crt;

var a : longint;

function DECHEX(x:longint):string;

const digits:array [0..15] of char = ('0','1','2','3','4','5','6','7',

'8','9','A','B','C','D','E','F');

var res:string; d:0..15;

begin

res:='';

while (x<>0) do

begin

d:=x mod 16;

x:=x div 16;

res:=digits[d]+res;

end;

DECHEX:=res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( DECHEX(a));

readln;

Еnd.

Программа перевода шестнадцатеричного числа в десятичное.

Program perevod4;

Uses Crt;

var a : string;

function HEXDEC(x: string): longint;

const digits: array [0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

var res, ves: longint;

i, j: byte;

begin

res:=0; ves:=1;

for i:=length(x) downto 1 do

begin

j:=0; a[i]:=UpCase(a[i]);

while (digits[j]<>x[i]) do inc(j);

res:=res+ves*j;

ves:=ves*16;

end;

HEXDEC:= res;

end;

Вegin { основная программа }

CIrScr;

readln( a );

writeln( HEXDEC(a));

readln;

Еnd.

Рекурсивные алгоритмы: нахождения НОД и НОК двух чисел.

Program nodnok;

Uses Crt;

var a,b:longint;

function NOD(x, y: longint): longint; { фукнция поиска наиб. общ. делителя }

begin

if x<>0 then NOD:=NOD(y mod x, x) else NOD:=y;

end;

function NOK(x, y: longint): longint; { фукнция поиска наим. общ. кратного }

begin

NOK:=( x div NOD(x, y) ) * y;

end;

Вegin { основная программа }

CIrScr;

write(‘Введите два числа ’);

readln(a, b);

writeln( 'НОД этих чисел = ', NOD(a, b) );

writeln( 'НОК этих чисел = ', NOK(a, b));

readln;

Еnd.

Рекурсивные алгоритмы: вычисление факториал.

Program factorial;

Uses Crt;

var n: integer;

function f(x: integer): longint;

begin

if x = 1 then f := 1 else f := x * f(x-1);

end;

Вegin

CIrScr;

writeln('введите N (N=1..13)');

readln(n);

writeln('N!=',f(n));

readln;

Еnd.

Геометрические алгоритмы: Пересекаются ли 2 отрезка?

------------------------------------------------------------------------

Определяет пересечение отрезков A(ax1,ay1,ax2,ay2) и B (bx1,by1,bx2,by2),

функция возвращает TRUE - если отрезки пересекаются, а если пересекаются

в концах или вовсе не пересекаются, возвращается FALSE (ложь)

------------------------------------------------------------------------

Program line;

Uses Crt;

function Intersection(ax1,ay1,ax2,ay2,bx1,by1,bx2,by2:real):boolean;

var v1,v2,v3,v4:real;

begin

v1:=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1);

v2:=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1);

v3:=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1);

v4:=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1);

Intersection:=(v1*v2<0) and (v3*v4<0);

end;

Вegin { основная программа, вызов функции - тест }

CIrScr;

writeln(Intersection(1,1,5,5,1,2,3,1)); {test1, yes Intersection}

writeln(Intersection(1,1,5,5,1,2,1,3)); {test2, no Intersection}

readln;

Еnd.

Геометрические алгоритмы: Точка внутри сектора или нет?

------------------------------------------------------------------------

Если точка внутри сектора (или на сторонах) - TRUE, если нет - FALSE

tx,ty - вершина сектора

x1,y1,x2,y2 - точки на сторонах сектора

px,py - точка на плоскости

возвращает знак числа, 1 - положительное число, -1 - отрицательное, 0 - 0

------------------------------------------------------------------------

Program inter;

Uses Crt;

function sign(r:real):integer;

begin

sign:=0; if r=0 then exit;

if r<0 then sign:=-1 else sign:=1;

end;

function InsideSector(tx,ty,x1,y1,x2,y2,px,py:real): boolean;

var x,y,a1,a2,b1,b2,c1,c2:real;

var i1,i2,i3,i4:integer;

begin

x:=(tx+x1+x2)/3; y:=(ty+y1+y2)/3;

a1:=ty-y1; b1:=x1-tx; c1:=tx*y1-ty*x1;

a2:=ty-y2; b2:=x2-tx; c2:=tx*y2-ty*x2;

i1:=sign(a1*x+b1*y+c1); i2:=sign(a2*x+b2*y+b2);

i3:=sign(a1*px+b1*py+c1); i4:=sign(a2*px+b2*py+c2);

InsideSector:=((i1=i3) and (i2=i4)) or ((i1=0) and (i2=i4)) or ((i1=i3) and (i2=0));

end;

Вegin { основная программа, вызов функции - тест }

CIrScr;

writeln(InsideSector(1,1,5,1,1,5,3,3)); {test1, yes Inside}

writeln(InsideSector(1,1,5,1,7,2,3,3)); {test2, no Intersection}

readln;

Еnd.

Арифметические алгоритмы: возведение целого числа в натуральную степень.

Program chislo;

Uses Crt;

var x,y:integer;

function Degree(a,b:integer):longint;

var r:longint;

begin

r:=1;

while b>0 do

begin

r:=r*a;

b:=b-1;

end;

Degree:= r;

end;

Вegin

CIrScr;

writeln('введите число и (через пробел) степень числа');

readln(x,y);

writeln(Degree(x,y)); { print x^y }

readln;

Еnd.

Графика

Библиотека CRT

Библиотека (модуль) CRTсодержит константы, переменные, процедуры и функции, обеспечивающие управление текстовым режимом работы монитора и звуковым генератором.

Процедуры

ClrScr Очищает экран или окно и помещает курсор в верхний левый угол.

Delay(D: Word)Приостанавливает работу программы на указанное числоDмиллисе­кунд. Практически время задержки зависит от тактовой частоты про­цессора.

GotoXY(X, Y: Byte) Перемещает курсор в позицию Х строки Y экрана.

NoSound Выключает источник звука.

Sound(F: Word) Запускает источник звука с частотойF(Гц).

TextBackGround(Color: Byte) Устанавливает цвет фона.

TextColor(Color: Byte) Устанавливает цвет символов.

Wmdow(Xl, Yl, X2, Y2: Byte)Определяет текстовое окно на экране. XI,Yl- координаты левого верхнего угла окна, X2, Y2 - правого нижнего угла окна.

Функции

KeyPressed: BooleanАнализирует нажатие клавиши. РезультатTRUE, если на клавиатуре нажата клавиша (кромеAlt,Ctrlи т. п.), иFALSEв противном слу­чае. Не задерживает исполнение программы.

ReadKey: CharЧитает символ с клавиатуры без эхоповтора на экране. Приостанав­ливает исполнение программы до нажатия на любую клавишу, кро­меAlt,Ctrlи т. п.

Библиотека GRAPH

Библиотека (модуль) GRAPHсодержит константы, процедуры и функции для управления графическим режимом работы монитора.

Константы цвета