Редагування та налагодження програм за допомогою Pascal

АКТЮБІНСЬК ПОЛІТЕХНІЧНИЙ КОЛЕДЖ

ЗВІТ

З НАВЧАЛЬНОЇ ПРАКТИЦІ

Виконав: Журмухамедов Марат

Перевірила: Гайсагалеева Б.М.

МАНГИШЛАК 2010

ЩОДЕННИК

Зміст

Лінійна програма на Паскаль

Програма з розгалуження

Циклічна програма

Масиви

Процедури і функції

Файлові дані в Паскалі

Записи в Паскалі

Рядки

Графіка в Турбо-Паскалі

Лінійна програма на Паскаль

Завдання 1. Скласти алгоритм обчислення y = 55 * (a + b)

program as; Блок-схема

uses crt;

var a, b, c, y: integer;

begin clrscr;

writeln ('Введи значення a, b);

readln (a, b);

c: = a + b;

y: = 55 * c;

writeln ('y =', y);

readln;

end.

(Вводимо значення 5,3)

Відповідь: 440

Завдання 2. Скласти алгоритм обміну значень 2х змінних A і B

program as; Блок-схема

uses crt;

var a, b, c: integer;

begin clrscr;

writeln ('Введи значення a, b');

readln (a, b);

c: = a;

a: = b;

b: = c;

writeln ('obmen', a ,'-', b);

readln;

end.

(Вводимо значення 5,6)

Відповідь: 6,5

Завдання 3. Обчислити площу городу, що має форму прямокутника, якщо відомі сторони А і В

program as; Блок-схема

uses crt;

var a, b, c: integer;

begin clrscr;

writeln ('Введи сторони А і В');

readln (a, b);

c: = (a + b) * 2;

writeln ('Площа городу =', c);

readln;

end.

(Вводимо значення 5,6)

Відповідь: 22

Завдання 4. Знайти середнє арифметичне чисел x, y, z

program as; Блок-схема

uses crt;

var x, y, z: integer; d: real;

begin clrscr;

writeln ('Bведі x, y, z');

readln (x, y, z);

d: = (x + y + z) / 3;

writeln (d: 5:2);

readln;

end.

(Вводимо значення 5,6,7)

Відповідь: 6.00

Завдання 5.Найті масу х літрів молока, якщо відомо, що щільність молока р кг / м ³

program as; Блок-схема

uses crt;

var x, p, m: real;

begin clrscr;

writeln ('Bведі х (у літрах), р (щільність) молока');

readln (x, p);

m: = x/100 * p;

writeln (m);

readln;

end.

(Вводимо значення 7л, 1030кг / м ³⁾

Відповідь: 7,21 кг

Завдання 6.Об'ем циліндра дорівнює V, а площа основи - S. Яка висота циліндра H?

program as; Блок-схема

uses crt;

var v, s, h: real;

begin clrscr;

writeln ('Введи об'єм циліндра і площ. його осн.');

readln (v, s);

H: = v / s;

writeln ('Висота циліндра =', H);

readln;

end.

(Вводимо значення 10,5)

Відповідь: 2м

Завдання 7.Дана довжина куба а. Знайти об'єм куба v і площа його бічній поверхні s.

program as;

uses crt;

var v, s, a: real;

begin clrscr;

writeln ('Bведі довжину ребра куба');

readln (a);

v: = a * a * a;

s: = 4 * a * a;

writeln ('об'єм =', v, 'площ.бок.пов .=', s);

readln;

end.

(Вводимо значення 5)

Відповідь: v = 125, s = 100

Завдання 8. Скласти алгоритм обчислення y = 2 ² * ((a + b) / 2)

program as; Блок-схема

uses crt;

var a, b, c: integer; d, y: real;

begin clrscr;

writeln ('Введи значення а, b');

readln (a, b);

c: = a + b;

d: = c / 2;

y: = sqr (2) * d;

writeln (y: 5:2);

readln;

end.

(Вводимо значення 5,5)

Відповідь: 20

Завдання 9.Ізвестна довжина окружності.Найті площа кола, огранич. цим колом

program as; Блок-схема

uses crt;

var a, b: real;

begin clrscr;

writeln ('Введи довжину окужності');

readln (a);

b: = (a * a) * pi;

writeln ('Знайти S кола =', b: 5:2);

end.

(Вводимо значення 5)

Відповідь: 78,5

Заданіе10. Дано натуральне число n (n> 9). Знайти число одиниць у ньому

program as; Блок-схема

uses crt;

var a, d: integer;

begin clrscr;

writeln ('Введи натуральне чісно');

readln (a);

d: = a mod 10;

writeln ('Кількість одиниць в ньому =', d);

readln;

end.

(Вводимо значення 6)

Відповідь: одиниць = 6

Заданіе11.Дано відстань у сантиметрах. Знайти число повних метрів у ньому.

program as; Блок-схема

uses crt;

var a, m: integer;

begin clrscr;

writeln ('Введи відстань у сантиметрах');

readln (a);

m: = a div 100;

writeln ('Отримай відстань в метрах', m);

readln;

end.

(Вводимо значення 200)

Відповідь: 2м

Заданіе12. Скласти алгоритм обчислення y = 7x ^2-3x +6

program as; Блок-схема

uses crt;

var x, y: integer;

begin clrscr;

writeln ('Bведі значення х');

readln (x);

y: = 7 * (sqr (x)) -3 * x +6;

writeln ('Y =', y);

readln;

end.

(Вводимо значення 6)

Відповідь: 240

Заданіе13.Каков об'єм кисню, що міститься в кімнаті розміром a * b * c, якщо кисень складає 21% об'єму повітря?

program as; Блок-схема

uses crt;

var a, b, c, v: real;

begin clrscr;

writeln ('Bвeді a, b, c');

readln (a, b, c);

v: = 0.21 * a * b * c;

writeln ('об'єм кисню =', v);

readln;

end.

(Вводимо значення 5,6,7)

Відповідь: 4.41

Заданіе14. Скласти алгоритм обчислення A = x ² + bx / 2

program as; Блок-схема

uses crt;

var a, b, x, z, s, v: real;

begin clrscr;

writeln ('Введи значення x, b');

readln (x, b);

z: = x * x * x * x * x;

s: = b * x;

v: = z + s;

A: = v / 2;

writeln ('A =', a);

readln;

end.

(Вводимо значення 2,3)

Відповідь: 1.9

Заданіе15.Определіть час падіння каменя на поверхню землі з висоти h.

program as; Блок-схема

uses crt;

var g, t, h: real;

begin clrscr;

writeln ('Введи значення h');

readln (h);

t: = sqrt (2 * h / g);

writeln ('час падіння =', t);

readln;

end.

(Вводимо значення 10 м)

Відповідь: 1,4278 з

Програма з розгалуження

Завдання 1.Дани 2 цілих числа, визначити яке з них більше

Program as; Блок-схема

Uses crt;

Var a, b: integer;

Max: integer;

Begin clrscr;

Writeln ('Введи 2 числа');

Readln (a, b);

If a> b then max: = a else max: = b;

Writeln ('Максимально =', max);

Readln;

End.

(Вводимо значення 5,6)

Відповідь: 6

Завдання 2.Ізвестни сторони трикутника, визначити чи рівні його боку (равноб) або різнобічно.

program as; Блок-схема

uses crt;

var a, b, c: integer;

begin clrscr;

writeln ('Введи боку');

readln (a, b, c);

if (a = b) or (a = c) or (c = b) Так Ні

then writeln ('равноб.') else writeln

('Різниці. ");

readln;

end.

(Вводимо значення 5,5,6)

Відповідь: Равноб.

Завдання 3.Проверіть, чи належить число, введене з клавіатури, інтервалу (-5; 3).

Program as; Блок-схема

Uses crt;

Var a, b, x: integer;

Begin clrscr;

Readln (x);

If (x> =- 5) and (x <= 3) then

Writeln ("так") else writeln ('немає');

End.

(Вводимо значення 2)

Відповідь: Належить

Завдання 4.Дано 2х зн. число. Визначити чи входить в нього цифра 3

Program as; Блок-схема

Uses crt;

Var a: integer;

Begin clrscr;

Writeln ('Введи 2х зн. Число');

Readln (a);

If (a div 10 = 3) or (a mod 10 = 3)

Then writeln ('Входить');

Else writeln ('Не входить');

Readln;

End.

(Вводимо значення 53)

Відповідь: Входить

Завдання 5. Дано 2х зн. число. Визначити яка з його цифр більше

Program as; Блок-схема

Uses crt;

Var a, d, e, max: integer;

Begin clrscr;

Writeln ('Дано 2х зн. Число');

Readln (a);

D: = a div 10;

E: = a mod 10;

If d> e then max: = d else max: = e;

Writeln ('Макс =', max);

Readln;

End.

(Вводимо значення 96)

Відповідь: 9

Завдання 6.Дани 2 цілих числа А і В, з'ясувати яв. Чи 2 числа, парними

Program as; Блок-схема

Var a, b: integer;

Begin clrscr;

Writeln ('Введи 2 цілих числа А і В');

Readln (a, b);

If a mod 2 = 0 then writeln ('парне')

else writeln ('не парне');

If b mod 2 = 0 then writeln ('парне');

else writeln ('не парне');

Readln;

End.

(Вводимо значення 5,6)

Відповідь: не парне, парне

Завдання 7.Решіть приклад-4x ² +8, x <0

Y =

x ² +3 x +4, x> 0 Блок-схема

Program as;

Uses crt;

Var x, y: integer;

Begin clrscr;

Writeln ('Введи аргумент x');

Readln (x);

If x> 0 then Y: =- 4 * sqr (x) +8

else Y: = sqr (x) +3 * x +4;

writeln ('Y =', y);

readln;

end.

Завдання 8. Дани три дійсних числа a, b, c. Перевірити чи виконується нерівність a <b <c.

program as; Блок-схема

uses crt;

var a, b, c: integer;

begin clrscr;

writeln ('Введи три числа');

readln (a, b, c);

if (a <b) and (b <c) then writeln ('вірно')

else writeln ('не вірно');

readln;

end.

(Вводимо значення 5,6,7)

Відповідь: виконується

Завдання 9.Дани три дійсних числа. Визначити, чи є серед них хоча б пара рівних між собою чисел

Program as; Блок-схема

Uses crt;

Var a, b, c: integer;

Begin clrscr;

Writeln ('Введи 3 числа');

Readln (a, b, c);

If (a = b) or (a = c) or (b = c) then writeln ('є')

else writeln ('не є');

end.

(Вводимо значення 5,6,7)

Відповідь: не є

Заданіе10.Дано дійсне число. Вивести на екран його абсолютну величину

Program as; Блок-схема

Uses crt;

Var a: real;

Begin clrscr;

Readln (a);

if (a> 0) or (a <0) then writeln (abs (a): 5:2);

readln;

end.

(Вводимо значення 56)

Відповідь: отримуємо абсол. величину.

Заданіе11. Дано 2 цілих числа, визначити яке з них менше

Program as; Блок-схема

Uses crt;

Var a, b: integer;

Min: integer;

Begin clrscr;

Writeln ('Введи 2 числа');

Readln (a, b);

If a <b then min: = a else min: = b;

Writeln ('Мінімальна =', min);

Readln;

End.

(Вводимо значення 5,6) Відповідь: 5

Заданіе12. Дано 2 числа. Якщо кв.корень з другого числа менше першого числа, то збільшити друге число в 5 разів

program as; Блок-схема

uses crt;

var a, b, d, c: real;

begin clrscr;

writeln ('Введи 2 числа');

readln (a, b);

d: = sqrt (a);

c: = sqrt (b);

if (d <c) then

writeln ('збільшити 2 число в 5 разів', c * c * c * c * c: 5:2)

else writeln ('немає рішення');

readln;

end.

Відповідь: ні рішення

Заданіе13. Дано число. Якщо це число парне, то / 2 якщо немає, то * 2

Program as; Блок-схема

Var a: integer;

Begin clrscr;

Writeln ('Введи число');

Readln (a);

If a mod 2 = 0 then writeln (a / 2)

else writeln (a * 2);

Readln;

End.

(Вводимо значення 5)

Відповідь: 10

Заданіе14.Дани 4 дійсних числа. Знайти суму тих чисел, які більше 5

Program as; Блок-схема

Uses crt;

Var a, b, c, d, k, z, x, v: integer;

Begin clrscr;

Writeln ('Введи 4 числа');

Readln (a, b, c, d);

If a> 5 then k: = a;

If b> 5 then z: = b;

If c> 5 then x: = c;

If d> 5 then v: = d;

Writeln ('Загальна сума =', k + z + x + v);

End.

(Вводимо значення 6,6,6,6)

Відповідь: 24

Заданіе15.Дани 3 числа a, b, c. Знайти максимальне

Program as; Блок-схема

Uses crt;

Var a, b, c: integer;

Max, max1: integer;

Begin clrscr;

Writeln ('Введи 3 числа');

Readln (a, b, c);

If a> b then max: = a else max: = b;

If max> c then max1: = max else max1: = c;

Writeln ('Максимально =', max1);

Readln;

End.

(Вводимо значення 5,6,7)

Відповідь: 7

Циклічна програма

Завдання 1.Надрукуйте "стовпчиком": всі цілі числа від 20 до 35

Program as; Блок-схема

Uses crt;

Var a: integer;

Begin clrscr;

For a: = 20 to 35 do writeln (a);

Readln;

end.

Завдання 2.Напечатать "стовпчиком": квадрати всіх цілих чисел від 10 до b (значення b вводиться з клавіатури, причому b> 10)

Program as; Блок-схема

Uses crt;

Var a, j: integer;

Begin clrscr;

Writeln ('Введи число');

Readln (j);

For a: = 10 to j do writeln (sqrt (a): 5:2);

Readln;

end.

Завдання 3.найти суму квадратів всіх цілих чисел від 10 до 50

Program as;

Uses crt;

Var a, s: real;

Begin clrscr;

For a: = 10 to 50 do s: = sqr (a) + s;

Writeln (s);

end.

Завдання 4.Одна штука деякого товару коштує 20 тенге. Надрукувати таблицю вартості 2,3 ... 20 штук цього товару

Блок-схема

Program as;

Uses crt;

Var a, b: integer;

Begin clrscr;

B: = 20;

For a: = 2 to 20 do writeln (a * b);

Readln;

end.

Завдання 5. Знайти добуток усіх цілих чисел від 1 до А (значення А вводиться з клавіатури; 1 <= A <= 20.

program as; Блок-схема.

uses crt;

var a, b, p: integer;

begin clrscr;

p: = 1;

readln (a);

for b: = 1 to a do if (1 <= a) and (a <= 20) then

p: = p * a;

writeln (p);

readln;

end.

(Вводимо значення 4)

Відповідь: 256

Завдання 6.Напечатать програму, друкувальну таблицю значень функції y = cos2x на відрізку [0; 1] з кроком h = 0,1

Program as; Блок-схема

Uses crt;

Var y, x: real;

Begin clrscr;

X: = 0;

While x <= 1 do begin y: = cos (2 * x);

Writeln (y: 5:2);

X: = x +0,1;

End;

End.

Завдання 7.Напечатать програму, обчислення факторіала

Program as; Блок-схема

Uses crt;

Var i, n: integer;

f: real;

Begin clrscr;

Readln (n);

F: = 1; i: = 1;

While i <= n do begin f: = f * i;

i: = succ (i);

end;

Writeln ('факторіал від', n, 'дорівнює', f);

End.

Завдання 8.Программа підрахунку суми S перших 1000 членів гармонійного ряду 1 +1 / 2 +1 / 3 + ​​... 1 / N

Program as; Блок-схема

Uses crt;

Var s: real;

N: integer;

Begin clrscr;

S: = 0; N: = 0;

While n <1000 do begin N: = n +1;

S: = s +1 / N;

End;

Writeln (s);

Readln;

End.

Завдання 9.Вичісліть найбільший спільний дільник двох натуральних чисел А і В.

Program as; Блок-схема

Uses crt;

Var a, b: integer;

Begin clrscr;

writeln ('Введи 2 натур. Числа');

readln (a, b);

While a <> b do if a> b then a: = ab

Else b: = ba;

Writeln ('НОД =', a);

Readln;

End.

Заданіе10. Дано цілі числа А і В (а> b). Визначити: Результат цілочисельного ділення А на В, не використовуючи стандартну операцію цілочисельного ділення

Program as; Блок-схема

Uses crt;

Var a, b, n: integer;

Begin clrscr;

writeln ('Введи 2 числа, a> b');

readln (a, b);

n: = 0;

While a <= b do begin

N: = n +1;

A: = ab;

\ End;

Writeln ('результат =', n);

Readln;

End.

Заданіе11.Напішіте програму, яка вводить цілі числа з клавіатури і складає їх, поки не буде введено число 0

Program as; Блок-схема

Uses crt;

Var N, s: integer;

Begin clrscr;

S: = 0;

Repeat write ('Введи число');

Readln (n);

S: = s + n;

Until n = 0;

Writeln ('S =', s);

Readln;

End.

Заданіе12. Надрукуйте 20 перших ступенів числа 2

Program as; Блок-схема

Uses crt;

Var N, s: longint;

Begin clrscr;

S: = 1; n: = 1;

Repeat s: = s * 2;

Write (s, '');

N: = n +1;

Until n> 20;

Readln;

End.

Заданіе13. Відомі оцінки з інформатики 20 учнів класу. На початку списку перераховані всі п'ятірки, потім всі інші оцінки. Скільки учнів мають по інфор-ке оцінку «5»?

Program as; Блок-схема

Uses crt;

Var x, n: integer;

Begin clrscr;

Write ('Введи оцінку');

Readln (x);

N: = 0;

While x = 5 do begin

N: = n +1;

Write ('Введи оцінку');

Readln (x);

End;

Writeln ('мають відмінно ", n,' учнів");

End.

Заданіе14.Вивесті на екран таблицю множення.

Program as; Блок-схема

Uses crt;

Var I, j: integer;

Begin clrscr;

For i: = 1 to 9 do

For j: = 1 to 9 do writeln (I, *, j, '', i * j);

Readln;

End.

Заданіе15.Составіть програму, друкувальну на екрані всі парні числа в діапазоні від 100 до 999.

Program as; Блок-схема

Uses crt;

Var a: integer;

Begin clrscr;

For a: = 100 to 999 do

If a mod 2 = 0 then writeln (a);

End.

Масиви

Завдання 1.Создать одновимірний масив і знайти суму парних елементів і твір непарних елементів

program as;

uses crt;

var a: array [1 .. 5] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 5 do a [i]: = random (8);

for i: = 1 to 5 do begin

writeln;

for i: = 1 to 5 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 5 do

if a [i] mod 2 = 0 then

s: = s + a [i]; writeln;

p: = 1;

for i: = 1 to 5 do

if a [i] mod 2 <> 0 then p: = p * a [i];

writeln;

writeln (s);

writeln (p);

end.

Завдання 2.Составіть програму формування одновимірного масиву і обчислення добутку всіх елементів масиву

program as;

uses crt;

var a: array [1 .. 5] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 5 do a [i]: = random (8);

for i: = 1 to 5 do begin

writeln;

for i: = 1 to 5 do write (a [i]: 5);

end;

writeln;

p: = 1;

for i: = 1 to 5 do p: = p * a [i];

writeln (p); end.

Завдання 3.Дан одновимірний масив обчислити добуток всіх парних елементів масиву

program as;

uses crt;

var a: array [1 .. 5] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 5 do a [i]: = random (8);

for i: = 1 to 5 do begin

writeln;

for i: = 1 to 5 do write (a [i]: 5);

end;

writeln;

p: = 1;

for i: = 1 to 5 do if a [i] mod 2 = 0 then p: = p * a [i];

writeln (p);

end.

Завдання 4.Дан масив обчислити суму всіх елементів більше 5

program as;

uses crt;

var a: array [1 .. 5] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 5 do a [i]: = random (88);

for i: = 1 to 5 do begin

writeln;

for i: = 1 to 5 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 5 do if a [i]> 5 then p: = p + a [i];

writeln (p);

readln;

end.

Завдання 5.Подщітать кількість елементів рівних 7

program as;

uses crt;

var a: array [1 .. 7] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 7 do a [i]: = random (88);

for i: = 1 to 7 do begin

writeln;

for i: = 1 to 7 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 7 do if a [i] = 7 then p: = p +1;

writeln (p);

readln;

end.

Завдання 6. Дано масив помножити всі елементи на 20

program as;

uses crt;

var a: array [1 .. 7] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 7 do a [i]: = random (88);

for i: = 1 to 7 do begin

writeln;

for i: = 1 to 7 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 7 do

write (a [i] * 20:3);

readln;

end.

Завдання 7. Дано масив всі парні елементи замінити на 2, а не парні подвоїти

program as;

uses crt;

var a: array [1 .. 7] of integer;

i, s, p: integer;

begin clrscr;

for i: = 1 to 7 do a [i]: = random (88);

for i: = 1 to 7 do begin

writeln;

for i: = 1 to 7 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 7 do if a [i] mod 2 = 0 then writeln (sqr (a [i]));

for i: = 1 to 7 do if a [i] mod 2 <> 0 then writeln (2 * a [i]);

readln;

end.

Завдання 8. Дан одновимірний масив знайти максимальний елемент

program as;

uses crt;

var a: array [1 .. 15] of integer;

i, max: integer;

begin clrscr;

for i: = 1 to 15 do a [i]: = random (88);

for i: = 1 to 15 do begin

writeln;

for i: = 1 to 15 do write (a [i]: 5);

end;

writeln;

max: = 1;

for i: = 1 to 15 do if a [i]> a [max] then max: = i;

writeln (a [max]);

readln;

end.

Завдання 9. Дан одновимірний масив знайти min елемент

program as;

uses crt;

var a: array [1 .. 15] of integer;

i, min: integer;

begin clrscr;

for i: = 1 to 15 do a [i]: = random (88);

for i: = 1 to 15 do begin

writeln;

for i: = 1 to 15 do write (a [i]: 5);

end;

writeln;

min: = 1;

for i: = 1 to 15 do if a [i] <a [min] then min: = i;

writeln (a [min]);

readln;

end.

Заданіе10. Дано масив скопіювати всі його елементи в інший масив такого ж елемента

program as;

uses crt;

var a: array [1 .. 15] of integer;

I, b: integer;

begin clrscr;

for i: = 1 to 15 do a [i]: = random (88);

for i: = 1 to 15 do begin

writeln;

for i: = 1 to 15 do write (a [i]: 5);

end;

writeln;

for i: = 1 to 15 do a [i]: = b [i];

for i: = 1 to 15 do write (a [i]);

writeln ('Копіюв');

for i: = 1 to 15 do write (b [i]: 4);

readln;

end.

Заданіе11. Скласти програму обміну першого і третього елем. рядки матриці

program as;

uses crt;

var a: array [1 .. 15] of integer;

I, b, c: integer;

begin clrscr;

for i: = 1 to 15 do a [i]: = random (88);

for i: = 1 to 15 do begin

writeln;

for i: = 1 to 15 do write (a [i]: 5);

end;

writeln;

c: = a [1];

a [1]: = a [3];

a [3]: = c;

for i: = 1 to 15 do write (a [i]: 5);

end.

Заданіе12. Дан 2 мірний масив. Вивести на екран всі елементи другого рядка

program as;

uses crt;

var a: array [1 .. 4,1 .. 4] of integer;

i, j: integer;

begin clrscr;

for i: = 1 to 4 do

for j: = 1 to 4 do a [i, j]: = random (99);

for i: = 1 to 4 do begin

writeln;

for j: = 1 to 4 do write (a [i, j]: 5);

end;

writeln;

writeln;

for j: = 1 to 4 do write (a [2, j]: 3);

end.

Заданіе13. Дан одновимірний масив. Поміняти вміст двох довільних осередків

program as;

uses crt;

var a: array [1 .. 10] of integer;

i, k, m: integer;

begin clrscr;

writeln;

for i: = 1 to 10 do a [i]: = random (99);

for i: = 1 to 10 do write (a [i]: 5);

writeln;

writeln;

k: = a [2];

a [2]: = a [4];

a [4]: = k;

for i: = 1 to 10 do write (a [i]: 5);

end.

Заданіе14. Дан 2 мірний масив. Замінити всі елементи кратні 5, нулями

program as;

uses crt;

var a: array [1 .. 5,1 .. 5] of integer;

i, j, s: integer;

begin clrscr;

for i: = 1 to 5 do

for j: = 1 to 5 do a [i, j]: = random (6);

for i: = 1 to 5 do begin

writeln;

for j: = 1 to 5 do write (a [i, j]: 5);

end;

writeln;

for i: = 1 to 5 do

for j: = 1 to 5 do begin

if a [i, j] mod 5 = 0 then a [i, j]: = 0;

end;

for i: = 1 to 5 do begin writeln;

for j: = 1 to 5 do write (a [i, j]: 5);

end;

end.

Заданіе15. Дано масив обчислити суму всіх елементів більше 20

program as; end;

uses crt; writeln;

var a: array [1 .. 10] of integer; for i: = 1 to 10 do if a [i]> 20 then p: = p + a [i];

i, s, p: integer; writeln (p);

begin clrscr; readln;

for i: = 1 to 10 do a [i]: = random (88); end.

for i: = 1 to 10 do begin

writeln;

for i: = 1 to 10 do write (a [i]: 5);

Процедури і функції

Завдання 1. Скласти програму обчислення числа поєднання C = n! (nm)!

program as;

uses crt;

var m, n, p1, p2, p3: integer;

c: real;

procedure factor (x: integer; var p: integer);

var i: integer;

begin p: = 1;

for i: = 1 to x do p: = p * i;

end;

begin clrscr;

writeln ('Vvedi m, n');

readln (m, n);

factor (m, p1);

factor (n, p2);

factor (nm, p3);

c: = p1 / (p2 * p3);

writeln (c: 5:2);

end.

Завдання 2. Скласти програму знаходження меншого з 5 заданих чисел, використовуючи процедуру знаходження меншого з 2 заданих чисел

Program as;

Uses crt;

Var a, b, c, d, e, z1, z2, z3, z4, z5: integer;

Procedure min (x, y: integer; var z: integer);

Begin;

If x <y then z: = x else z: = y;

Writeln (z);

End;

Begin clrscr;

Readln (a, b, c, d, e);

Min (a, b, z1);

Min (z1, c, z3);

Min (z3, d, z4);

Min (z4, e, z5);

End.

Завдання 3. Написати програму знаходження суми більшого і меншого з 3 заданих чисел

Program as;

Uses crt;

Var a, b, c, d, v, v1, max, max1, min, min1: integer;

Procedure ma (x, y, z: integer; var v: integer);

Begin clrscr;

If x <y then max: = x else max: = y;

If max <z then max1: = max else max1: = z;

If x> y then min: = x else min: = y;

If min> z then min1: = min else min1: = z;

V: = min1 + max1;

End;

Begin clrscr;

Readln (a, b, c);

Ma (a, b, c, v1);

Writeln (v1);

End.

Завдання 4. Скласти програму обчислення сумою фактор. всіх парних чисел від m до n

program as;

uses crt;

var a, b, c, n, m, s, k, p1, p: integer;

procedure factor (x: integer; var p: integer);

var i: integer;

begin p: = 1;

for i: = 1 to x do begin p: = p * I; end;

writeln (p);

end;

begin clrscr;

writeln ('Vvedi n, m');

readln (n, m);

for k: = n to m do if k mod 2 = 0 then begin

factor (k, p1);

s: = s + p1;

end;

writeln (s);

end.

Завдання 5. Дано 5 чисел, знайти їх найбільший спільний дільник, використовуючи процедуру. Для алгоритму їх виду

program as;

uses crt;

var a, b, c, d, e, z1, z2, z3, z: integer;

procedure E (x, y: integer; var z: integer);

begin

while x <> y do if x> y then x: = xy

else y: = y-1;

z: = x;

end;

begin clrscr;

writeln ('Vvedi a, b, c, d, e');

readln (a, b, c, d, e);

E (a, b, z);

E (c, d, z1);

E (z, z1, z2);

E (z2, e, z3);

writeln (z3);

end.

M!

Завдання 6. Скласти програму обчислення числа поєднання C = n! (nm)! за допомогою функції

program as;

uses crt;

var f1, f2, f3, m, m1, n: integer;

c: real;

Function factor (n: integer): integer;

var p, i: integer;

begin p: = 1;

for i: = 1 to n do p: = p * i;

factor: = p;

end;

begin

read (m, n);

f1: = factor (m);

f2: = factor (n);

m1: = nm;

f3: = factor (m1);

c: = f1 / (f2 * m1);

writeln (c: 5:2);

end.

Завдання 7. Знайти НОК двох чисел за формулою НОК (a, b) = НОД

Program as;

Uses crt;

Var m, n, z, nod, a, nok: integer;

Procedure F (a, b: integer; var nod: integer);

Begin

While a <> b do if a> b then a: = ab else b: = ba;

Nod: = a;

End;

Begin clrscr;

Readln (m, n);

F (m, n, z);

Nok: = trunk (z / (m * n));

Writeln (nok);

End.

Завдання 8. Трехугольнік заданий з координ. своїх вершин. Скласти програму обчислення його периметра

Program as;

Uses crt;

Var a1, a2, c1, c2, b1, b2: integer;

d1, d2, d3, d: real;

c, p: real;

procedure F (x1, x2, y1, y2: integer; var d: read);

begin

d: = sqrt (sqr (x2-x1) + sqr (y2-y1));

writeln (d: 5:2);

end;

begin clrscr;

readln (a1, a2, b1, b2, d1, d2);

F (a1, a2, c1, c2, d1);

F (c1, c2, b1, b2, d2);

F (d1, d2, a1, a2, d3);

P: = d1 + d2 + d3;

Writeln (p: 8:5);

End.

Завдання 9. Збільшити вдвічі всі елементи масиву

program as;

const n = 10; m = 20;

type T1 = array [1 .. n] of integer;

T2 = array [-m .. m] of integer;

var A: T1; B: T2; k: integer;

Procedure Double (var X: array of integer);

var i: byte;

begin

for i: = 0 to High (X) -1 do X [i]: = X [i] * 2;

end;

begin

for k: = 1 to n do read (A [k]);

for k: =- m to m do read (B [k]);

Double (A);

Double (B);

Double (k);

writeln ('k =', k);

for k: = 1 to n do write (A [k], '');

writeln;

for k: =- m to m do write (B [k], '');

end.

Завдання 10. Використання типізованих констант

program typed_const;

var N: integer;

procedure Test;

const k: integer = 1;

begin

if k <N then

begin

writeln (k, '-й виклик процедури');

k: = k +1;

Test;

end

else writeln ('останній виклик процедури');

end;

begin

read (N);

if N> 0 then Test;

end.

Завдання 11. Обчислити N-е число Фіббоначчі

program Fib;

var n: byte;

function F (k: byte): word;

begin

if k <2 then F: = 1 else F: = F (k-1) + F (k-2);

end;

begin

write ('введіть номер числа Фіббоначчі');

readln (N);

writeln (N, '-е число Фіббоначчі =', F (N));

readln

end.

Заданіе12. Дано 5 чисел, знайти їх найбільший спільний дільник, використовуючи процедуру. Для алгоритму їх виду

program as;

uses crt;

var a, b, c, d, e, z1, z2, z3, z: integer;

procedure E (x, y: integer; var z: integer);

begin

while x <> y do if x> y then x: = xy

else y: = y-1;

z: = x;

end;

begin clrscr;

writeln ('Vvedi a, b, c, d, e');

readln (a, b, c, d, e);

E (a, b, z);

E (c, d, z1);

E (z, z1, z2);

E (z2, e, z3);

writeln (z3);

end.

Заданіе13. Трехугольнік заданий з координ. своїх вершин. Скласти програму обчислення його периметра

Program as;

Uses crt;

Var a1, a2, c1, c2, b1, b2: integer;

d1, d2, d3, d: real;

c, p: real;

procedure F (x1, x2, y1, y2: integer; var d: read);

begin

d: = sqrt (sqr (x2-x1) + sqr (y2-y1));

writeln (d: 5:2);

end;

begin clrscr;

readln (a1, a2, b1, b2, d1, d2);

F (a1, a2, c1, c2, d1);

F (c1, c2, b1, b2, d2);

F (d1, d2, a1, a2, d3);

P: = d1 + d2 + d3;

Writeln (p: 8:5);

End.

Заданіе14. Скласти програму для обчислення визначеного інтеграла

tk

2t

I = S --------------- dt

sqrt (1-sin2t)

tn

обчислюється за формулою:

ISimps = 2 * h / 3 * (0.5 * F (A) +2 * F (A + h) + F (A +2 * h) +2 * F (A +3 * h )+...

+2 * F (Bh) +0.5 * F (B))

Program INTEGRAL;

type

Func = function (x: Real): Real;

var

I, TN, TK: Real;

N: Integer;

{$ F +}

Function Q (t: Real): Real;

begin

Q: = 2 * t / Sqrt (1-Sin (2 * t));

end;

{$ F-}

Procedure Simps (F: Func; a, b: Real; N: Integer; var INT: Real);

var

sum, h: Real;

j: Integer;

begin

if Odd (N) then N: = N +1;

h: = (ba) / N;

sum: = 0.5 * (F (a) + F (b));

for j: = 1 to N-1 do

sum: = sum + (j mod 2 +1) * F (a + j * h);

INT: = 2 * h * sum / 3

end; begin WriteLn ('Введіть TN, TK, N');

Read (TN, TK, N);

Simps (Q, TN, TK, N, I);

WriteLn ('I =', I: 8:3)

end.

Заданіе15. Записати відрізок-X (-1, -10), за допомогою функції

program as;

function A (x: integer): integer;

begin

a: =- x;

end;

var i: integer;

begin

for i: = 1 to 10 do writeln (a (i));

end.

Файлові дані в Паскалі

Завдання 1. Дан текстовий файл, порахувати кількість рядків у ньому

Program as;

Uses crt;

Var F: text; a: string; s: integer;

Begin clrscr;

Assign (f, 'a1.txt');

Reset (f);

While not (eof (f)) do begin

Readln (f, a);

S: = s +1; end;

Close (f);

Writeln (s);

End.

Завдання 2. Створити текстовий файл і записати в нього фразу: «Здрастуй Мир!»

Program as;

Uses crt;

Var F: text; a: string;

Begin clrscr;

Assign (f, 'a.txt');

Rewrite (f);

Readln (a);

Writeln (f, a);

Close (f);

End.

Завдання 3. Створити текстовий файл і записати в нього слово «Привіт»

Program as;

Uses crt;

Var F: text; a: string;

Begin clrscr;

Assign (f, 'A.txt');

Rewrite (f);

Readln (a);

Writeln (f, a);

Close (f);

End.

Завдання 4. Створити текстовий файл і записати в нього 5 однакових чисел

Program as;

Uses crt;

Var F: text; a: string; i: integer;

Begin clrscr;

Assign (f, 'text.txt');

Rewrite (f);

For i: = 1 to 5 do

Writeln (f, 5);

Close (f);

End.

Завдання 5. Створити текстовий файл і записати в нього всі числа від 10 до 16

Program as;

Uses crt;

Var F: text; a: string; i: integer;

Begin clrscr;

Assign (f, 'text.txt');

Rewrite (f);

For i: = 10 to 16 do

Writeln (f, i);

Close (f);

End.

Завдання 6. Створити текстовий файл і записати в нього 5 однакових слів

Program as;

Uses crt;

Var F: text; a: string;

Begin clrscr;

Assign (f, 'A.txt');

Rewrite (f);

Readln (a);

Writeln (f, a);

Close (f);

End.

Завдання 7. Дан текстовий файл перенести його рядки в інший файл

Program as;

Uses crt;

Var f, t: text; a: string;

Begin clrscr;

Assign (f, '202as. Txt '); assign (t, '201as. Txt');

Reset (f); rewrite (t);

While not (eof (f)) do begin

Readln (f, a);

Writeln (t, a);

End;

Close (f);

Close (t);

Readln;

End.

Завдання 8. Є текстовий файл, надрукувати всі його рядки починаючи з літери Т

Program as;

Uses crt;

Var f: text; a: string;

Begin clrscr;

Assign (f, '202as. Txt ');

Reset (f);

While not (eof (f)) do begin

Readln (f, a);

If copy (a, 1,1) = 'T' then

Writeln (a);

End;

Close (f);

Readln;

End.

Завдання 9. Є текстовий файл порахувати кількість рядків починаються на букву А

Program as; readln (f, a);

Uses crt; if copy (a, 1,1) = 'A' then k: = k +1;

Var F: text; a: string; k: integer; end;

Begin clrscr; close (f);

Assign (f, 'abc.txt'); writeln (k);

Reset (f); end.

While not (Eof (f)) do begin

Заданіе10. Всі парні рядки цього файлу записати у 2 файл, а не парні в 3 файл

Program as;

Uses crt;

Var F, t, g: text; a: string; k: integer;

Begin clrscr;

Assign (f, 'abc.txt'); assign (t, 'cop.txt'); Assign (g, 'cap.txt');

Reset (f); rewrite (t); rewrite (g);

While not (Eof (f)) do begin

Readln (f, a);

K: = k +1;

If k mod 2 = 0 then writeln (t, a) else writeln (g, a);

End;

Close (f); close (t); close (g);

End.

Заданіе11. Знайти суму елементів одновимірного масиву рез-т записати в текстовий файл

Program as;

Uses crt;

Var f: text; a: array [1 .. 10] of integer; i, s: integer;

Begin clrscr;

Writeln ('Введення масиву');

Assign (f, 'abc.txt'); rewrite (f);

For i: = 1 to 10 do begin write ('Введи', I, 'елемент масиву');

Readln (a [i]);

End;

Writeln;

For i: = 1 to 10 do s: = s + a [i];

Writeln (f, s);

Close (f);

End.

Заданіе12. Створити текстовий файл і записати в нього всі числа від 5 до 25

Program as;

Uses crt;

Var F: text; a: string; i: integer;

Begin clrscr;

Assign (f, 'text.txt'); Rewrite (f);

For i: = 5 to 25 do

Writeln (f, i);

Close (f);

End.

Заданіе13. Дано слово подвоїти його кожну букву і записати його в текст. файл

Program as;

Uses crt;

Var f: text; a: string; I, s: integer;

Readln (a);

For i: = 1 to length (a) * 2 do begin insert

Copy (a, I, 1), a, i);

I: = i +1;

End;

Writeln (f, a);

Close (f);

End.

Заданіе14. Є текстовий файл порахувати кількість рядків починаються на букву М

Program as;

Uses crt;

Var F: text; a: string; k: integer;

Begin clrscr;

Assign (f, 'abc.txt');

Reset (f);

While not (Eof (f)) do begin

readln (f, a);

if copy (a, 1,1) = 'М' then k: = k +1;

end; close (f);

writeln (k);

end.

Завдання 15. Створити текстовий файл і записати в нього 6 однакових чисел

Program as;

Uses crt;

Var F: text; a: string; i: integer;

Begin clrscr;

Assign (f, 'text.txt');

Rewrite (f);

For i: = 1 to 6 do

Writeln (f, 6);

Close (f);

End.

Записи в Паскалі

Завдання 1. Скласти список навчальної групи, що включає 25 осіб. Для кожного учня вказати дату народження, рік вступу в технікум, курс, групу, оцінки кожного року навчання. Інформацію про кожного учня оформити в програмі у вигляді запису. Сукупність записів об'єднати в масив.

Скласти програму, яка забезпечує введення отриманої інформації, роздруківку її у вигляді таблиці, а також роздруківку інформації про відмінників

Program Pascal;

Uses crt;

type student = record

fio: string;

d_r: 1 .. 31; {день народження}

m_r: 1 .. 12; {місяць народження}

god_r: 1965 .. 1975; {рік народження}

god_p: 2004 .. 2008; {рік надходження}

group: string; {назва групи}

ocenki: array [1 .. 3,1 .. 5] of integer; {оцінки з трьох предметів}

end;

var

s1: array [1 .. 25] of student;

i, j, x: integer;

ch: char;

f: boolean;

begin

clrscr;

for i: = 1 to 25 do begin

writeln ('Відомості про', i, 'студента');

with s1 [i] do begin

write ('ПІБ:'); readln (fio);

write ('Дата народження: .. р.');

x: = wherex;

gotoxy (x-13, wherey); read (d_r);

gotoxy (x-10, wherey-1); read (m_r);

gotoxy (x-7, wherey-1); read (god_r);

if keypressed then begin

ch: = readkey;

if ch = # 0 then ch: = readkey;

end;

write ('Рік вступу:'); readln (god_p);

write ('Група:'); readln (group);

j: = 0;

for i: = god_p to 2008 do begin

j: = j +1;

writeln ('Оцінки за', i, 'рік:');

write ('Математика:'); readln (ocenki [1, j]);

write ('Інформатика:'); readln (ocenki [2, j]);

write ('Історія:'); readln (ocenki [3, j]);

end;

end;

writeln;

end;

writeln ('список відмінників');

for i: = 1 to 25 do begin

with s1 [i] do begin

j: = 0;

f: = true;

for i: = god_p to 2008 do begin

j: = j +1;

if not ((ocenki [1, j] = 5) and (ocenki [1, j] = 5) and (ocenki [1, j] = 5)) then f: = false;

end;

if f = true then writeln (fio, ', група', group, ', рік надходження', god_p);

end;

end;

writeln ('Для виходу натисніть Enter');

readln;

end.

Завдання 2. Розробити програму формування файла, що містить відомості про студентів. Кожен елемент цього файлу повинен містити наступні дані: номер групи; номер у групі за списком; прізвище, ім'я, по батькові, рік народження; оцінки за останню сесію

Program Pascal;

Uses crt;

Const fname = 'students.dat';

n = 5; {кількість предметів за останню сесію}

Type st = record

n_group: integer; {номер групи}

n_sp: integer; {номер у групі за списком}

fam: string; {прізвище}

im: string; {ім'я}

ot: string; {батькові}

god_r: integer; {рік народження}

oc: array [1 .. n] of integer; {оцінки за останні сесії}

end;

Var t: array [1 .. 30] of st;

i, ch, j: integer;

h: file of st;

begin

write ('Введіть кількість студентів у групі:'); readln (ch);

for i: = 1 to ch do begin

writeln ('Відомості про', i, 'студента');

write ('Номер групи:'); readln (t [i]. n_group);

write ('Номер в групі за списком:'); readln (t [i]. n_sp);

write ('Прізвище:'); readln (t [i]. fam);

write ('Ім'я:'); readln (t [i]. im);

write ('По батькові:'); readln (t [i]. ot);

write ('Рік народження:'); readln (t [i]. god_r);

writeln ('Оцінки за останню сесію:');

for j: = 1 to n do begin

case j of

1: write ('Математика:');

2: write ('Фізика:');

3: write ('Хімія:');

4: write ('Культурологія:');

5: write ('Історія:');

end;

readln (t [i]. oc [j]);

if not ((t [i]. oc [j]> 0) and (t [i]. oc [j] <= 5)) then begin

writeln ('Невірно введена оцінка! Повторіть ввід.');

j: = j-1;

end;

end;

writeln;

end;

Assign (h, fname);

{$ I-}

reset (h);

If Ioresult <> 0 then rewrite (h);

{$ I +}

for i: = 1 to ch do write (h, t [i]);

close (h);

writeln ('Дані занесені в файл', fname);

readln;

end.

Завдання 3. У ГИБДД є наступна інформація про автомобілі та їх власників:

а) марка машини;

б) номер машини;

в) Прізвище власника.

Необхідно організувати пошук кількості автомобілів певної марки. Інформацію про автомобілі та їх власників оформити у вигляді записів, що зберігаються у файлі. Введення даних до запису і збереження запису у файлі

Program N10_1;

Uses Crt;

Const fname = 'spisok.dat';

{Назва файлу, в який проводитиметься запис}

Type Person = record

marka: string;

number: string;

familia: string;

end;

Var auto: array [1 .. 5] of person;

i: integer;

h: file of person;

begin

Clrscr;

auto [1]. marka: = 'Мерседес';

auto [1]. number: = '235 ';

auto [1]. familia: = 'Іванов';

auto [2]. marka: = 'Мерседес';

auto [2]. number: = '289 ';

auto [2]. familia: = 'Петров';

auto [3]. marka: = 'Волга';

auto [3]. number: = '365 ';

auto [3]. familia: = 'Сидоров';

auto [4]. marka: = 'Жигулі';

auto [4]. number: = '896 ';

auto [4]. familia: = "Кузнєцов ';

auto [5]. marka: = 'Вольво';

auto [5]. number: = '957 ';

auto [5]. familia: = 'Тимофєєв';

Assign (h, fname);

{$ I-}

reset (h);

If Ioresult <> 0 then rewrite (h);

{$ I +}

for i: = 1 to 5 do begin

write (h, auto [i]);

end;

writeln ('Дані занесені в файл', fname);

write ('Натисніть Enter');

readln;

end.

Виконання завдання

Program N10_2;

Uses Crt;

Const fname = 'spisok.dat';

Type Person = record

marka: string;

number: string;

familia: string;

end;

Var auto: array [1 .. 5] of person;

i, j, l, q: integer;

h: file of person;

s: string;

f: boolean;

begin

Clrscr;

Assign (h, fname);

Reset (h);

i: = 0;

While Eof (h) = false do begin

i: = i +1;

Read (h, auto [i]);

end;

Close (h);

writeln ('Інформація, лічена з файлу', fname);

writeln;

q: = i;

for j: = 1 to q do begin

with auto [j] do begin

gotoxy (1, wherey);

write (marka);

gotoxy (15, wherey);

write (number);

gotoxy (20, wherey);

writeln (familia);

end;

end;

writeln;

write ('Введіть цікавить Вам марку автомобіля:');

readln (s);

writeln;

l: = 0;

for j: = 1 to q do begin

with auto [j] do begin

if marka = s then begin

l: = l +1;

gotoxy (1, wherey);

write (number);

gotoxy (10, wherey);

writeln (familia);

end;

end;

end;

writeln ('Кількість автомобілів даної марки -', l);

write ('Натисніть Enter');

readln;

end.

Завдання 4. На телефонному вузлі в кінці кожного кварталу складається на кожного абонента відомість оплати міжміських телефонних розмов (з 7-ма містами) протягом кварталу (3 місяці)

Написати програму, яка вводить вихідні дані, виконує розрахунки і виводить на екран:

• Вихідні дані у вигляді таблиці, де вказані коди міст, з якими велися розмови, загальний час розмови з кожним містом за один місяць, вартість однієї хвилини розмови (змінюється кожен місяць);

• Загальна тривалість розмов з кожним містом за квартал;

• Плата за кожний місяць;

• Загальна плата за 3 місяці;

• Місто з найбільшою платою.

program kursovik;

uses crt;

type

telef = record

kod: integer;

tpm1, tpm2, tpm3, price1, price2, price3: integer;

end;

telef1 = record

kod, tpm, ob: integer;

pr1, pr2, pr3: integer;

end;

var

a: file of telef;

res: array [1 .. 7] of telef1;

i, j, s, aa, max: integer;

begin;

textbackground (10);

clrscr;

textcolor (0);

gotoxy (15,2);

writeln ('Курсова робота студента групи 01М22 Білоусової Є.В.');

gotoxy (27,3);

writeln ('Завдання на курсову роботу:');

textcolor (4);

writeln;

writeln ('На телефонному вузлі в кінці кожного кварталу складається на кожного абонента');

writeln ('відомість оплати міжміських телефонних розмов (з 7-ма містами) протягом');

writeln ('кварталу (3 місяці ).');

writeln ('Написати програму, яка вводить вихідні дані, виконує розрахунки і');

writeln ('виводить на екран:');

writeln ('- вихідні дані у вигляді таблиці, де вказані коди міст, з якими велися');

writeln ('розмови, загальний час розмови з кожним містом за один місяць, вартість ");

writeln ('однієї хвилини розмови (змінюється кожен місяць );');

writeln ('- загальна тривалість розмов з кожним містом за квартал;');

writeln ('плата за кожний місяць;');

writeln ('загальна плата за 3 місяці;');

writeln ('місто з наібльшей платою.');

gotoxy (27,18);

textcolor (0);

writeln ('Вимога до введення інформації');

textcolor (4);

writeln ('- вихідні дані вводяться з клавіатури.');

textcolor (0);

writeln;

writeln ('Вимога до висновку результатів');

textcolor (4);

writeln ('- результат виводяться на екран.');

textcolor (14);

writeln;

writeln ('Для продовження роботи програми натисніть ENTER');

readln;

clrscr;

textcolor (0);

writeln ('Вимоги до структури програми');

textcolor (4);

writeln ('Програма повинна складатися з наступних частин:');

writeln ('- висновок заставки з інформацією про студента та завданні;');

writeln ('- введення даних (виконується в діалоговому режимі );');

writeln ('- висновок вихідних даних і результатів (на один екран ).');

textcolor (0);

writeln ('Вимоги до розміщення вихідних даних усередині програми');

textcolor (4);

writeln ('Вихідні дані розташовуються у файлі, компонентами якого є записи.');

writeln ('Структура кожного запису і типи її полів вибираються в залежності від завдання.');

textcolor (0);

writeln ('Використовувані кольори');

textcolor (4);

writeln ('- чорний (0), червоний (4), світло-зелений (10), жовтий (14)');

textcolor (14);

gotoxy (18,24);

writeln ('Для продовження роботи програми натисніть ENTER');

readln;

clrscr;

assign (a, 'kurs.dat');

rewrite (a);

textcolor (0);

for i: = 1 to 7 do

begin

write ('Введіть код', i, '-го міста:');

readln (tel.kod);

write ('Введіть загальний час розмови з містом', tel.kod, 'за 1-й місяць:');

readln (tel.tpm1);

write ('Введіть вартість однієї хвилини розмови з містом', tel.kod, 'в 1-му місяці:');

readln (tel.price1);

write ('Введіть загальний час розмови з містом', tel.kod, 'за 2-й місяць:');

readln (tel.tpm2);

write ('Введіть вартість однієї хвилини розмови з містом', tel.kod, 'в 2-му місяці:');

readln (tel.price2);

write ('Введіть загальний час розмови з містом', tel.kod, 'за 3-й місяць:');

readln (tel.tpm3);

write ('Введіть вартість однієї хвилини розмови з містом', tel.kod, 'в 3-му місяці:');

readln (tel.price3);

write (a, tel);

end;

close (a); reset (a);

s: = 1;

while not eof (a) do begin

read (a, tel);

res [s]. kod: = tel.kod;

res [s]. tpm: = tel.tpm1 + tel.tpm2 + tel.tpm3;

res [s]. pr1: = tel.tpm1 * tel.price1;

res [s]. pr2: = tel.tpm2 * tel.price2;

res [s]. pr3: = tel.tpm3 * tel.price3;

res [s]. ob: = res [s]. pr1 + res [s]. pr2 + res [s]. pr3;

s: = s +1;

end; close (a);

clrscr;

writeln ('Код міста Загальний час розмови за кожен місяць Вартість хвилини розмови');

reset (a);

while not eof (a) do

begin

read (a, tel);

writeln ('', tel.tpm1, '', tel.price1);

writeln ('', tel.kod, '', tel.tpm2, '', tel.price2);

writeln ('', tel.tpm3, '', tel.price3);

end;

textcolor (14);

gotoxy (18,24);

writeln ('Для продовження роботи програми натисніть ENTER');

readln;

clrscr;

textcolor (0);

writeln ('Код міста Загальний час розмови за квартал Плата за місяць Загальна плата');

for i: = 1 to 7 do

begin

aa: = res [i]. kod;

writeln ('', res [i]. pr1);

writeln ('', aa, '', res [i]. tpm, '', res [i]. pr2, '', res [i]. ob);

writeln ('', res [i]. pr3);

end;

max: = res [1]. ob;

for i: = 1 to 6 do begin

if res [i +1]. ob> max then

begin

max: = res [i +1]. ob;

j: = i +1;

end;

end;

writeln ('Місто з найбільшою платою:', res [j]. kod);

textcolor (14);

gotoxy (18,24);

writeln ('Для завершення роботи програми натисніть ENTER');

readln;

end.

Завдання 5 Упорядкувати список студентів за середнім балу і роздрукувати його

Program spisok_grupp;

Uses Crt;

Const kurs = 3;

Const kol = 5;

Type

sved = record

famil: string [25];

datar: string [8];

god: integer;

gruppa: integer;

ocenki: array [1 .. 3,1 .. 5] of integer;

srball: array [1 .. 25] of real;

End;

Var

spisok: array [1 .. 25] of sved;

i, i1, j, s, mesto, n, g: integer;

max, t: real;

q: string [25];

Begin

ClrScr;

writeln ('Введіть кількість учнів ");

readln (n);

for i: = 1 to n do

With spisok [i] do

Begin

Writeln ('Прізвище', i, 'студента');

Readln (famil);

Writeln ('Дата народження');

Readln (datar);

Writeln ('Рік вступу');

Readln (god);

Writeln ('Група');

Readln (gruppa);

s: = 0;

for i1: = 1 to kurs do

begin

writeln ('Оцінки', i1, 'року');

for j: = 1 to kol do

Begin

Writeln (j, 'Предмет');

Readln (ocenki [i1, j]);

s: = s + ocenki [i1, j];

End;

end;

srball [i]: = s / (kol * kurs);

ClrScr;

End;

writeln ('Прізвище': 8, 'Дата народження': 16, 'Рік вступу': 18, 'Курс': 7, 'Група': 8);

for i: = 1 to n do

begin

with spisok [i] do write (famil: 8, datar: 16, god: 18, kurs: 7, gruppa: 8);

writeln;

writeln;

for g: = 1 to kurs do

begin

write (g, 'рік:');

for j: = 1 to kol do

with spisok [i] do write (ocenki [g, j]: 4);

writeln;

end;

with spisok [i] do writeln ('Середній бал =', srball [i]: 6:2);

writeln;

end;

writeln;

writeln ('По порядку');

for j: = 1 to n do

Begin

max: = spisok [j]. srball [j];

mesto: = j;

for i: = j to n do

if spisok [i]. srball [i] <= max then

Begin

max: = spisok [i]. srball [i];

mesto: = i;

End;

t: = spisok [j]. srball [j];

spisok [j]. srball [j]: = spisok [mesto]. srball [mesto];

spisok [mesto]. srball [mesto]: = t;

q: = spisok [j]. famil;

spisok [j]. famil: = spisok [mesto]. famil;

spisok [mesto]. famil: = q;

with spisok [j] do writeln (famil: 8, srball [j]: 6:2);

End;

End.

Завдання 6. Запис з варіантами

var R = Record

rem: string;

Case byte of

3: (n: integer);

5: (x, y, z: char);

'A': (i, j: byte);

end;

begin

R.rem: = 'запис з ваpиантах';

Rn: = 25000;

write (Ri, Rx, Rj, Ry); {168і97a}

{Ord ('і') = 168, ord ('a') = 97, 168 +97 * 256 = 25000}

end.

Завдання 7. Приклад оголошення типу запис

type Men = Record

FIO, Adress: string;

Year: byte;

End;

var A, B: Men;

begin

A. FIO: = 'Іванов І.І.';

A. Adress: = 'пp. Леніна, буд 40, кв. 10 ';

A. Year: = 1981;

end.

Завдання 8. Скласти програму в якій відомі Прізвище, адресу і номери Телефонів 15 осіб, організувати пошук номера телефону на прізвище абонента

Program as;

Type

person = record

surname: string [40]

adres: string [20]

nomer: integer

var

mas: array [1 .. 15] of person;

i: integer; poisk: string;

procedure Input.date;

var

begin

writeln ('Введи дані', I, 'абонента');

writeln ('Прізвище');

readln (mas [i]. surname);

writeln ('адреса');

readln (mas [i]. adres);

writeln ('Номер телефону');

readln (mas [i]. nomer);

end;

Procedure write date;

Begin

With mas [i] do

Begin

Writeln ('прізвище', surname);

Writeln ('адреса', adres);

Writeln ('номер', nomer);

End;

End;

Begin

For i: = 1 to 15 do Input.date;

Writeln ('Введи прізвище абонента');

Readln (poisk);

For i: = 1 to 15 do

If mas [i] nomer = poisk then write date;

End.

Завдання 9. Створити список учнів класу і вивести на екран Прізвища та Імена у вигляді таблиці

Program as;

Uses crt;

Type

Klass = record

Surname: string [15];

Name: string [10];

End;

Var A: array [1 .. 10] of klass;

I: integer;

Begin clrscr;

For i: = 1 to 10 do begin

Writeln ('введи прізвище');

Readln (a [i]. Surname);

Writeln ('введи ім'я');

Readln (a [i]. Name);

End;

Writeln;

Clrscr;

For i: = 1 to 10 do writeln (a [i]. Surname, '', a [i]. Name);

End.

Заданіе10. Відомі дані про 6 співробітників фірми Прізвище, вік, і ставлення до воен.службе. Вивести на екран прізвища всіх військовозобов'язаних співробітників

Program as;

Uses crt;

Type

S = record

N: string [10]; voz: integer;

V: string [8];

End;

Var a: array [1 .. 6] of s;

I: integer;

Begin clrscr;

For i: = 1 to 6 do begin

Writeln ('яке в нього прізвище');

Readln (a [i]. S);

Writeln ('скільки тобі років');

Readln (a [i]. Voz);

Writeln ('ти относешся до військової частини');

Readln (a [i]. V);

End; Writeln; Clrscr;

For i: = 1 to 6 do if a [i]. V = 'DA' then writeln (a [i]. S);

End.

Заданіе11. Дано назви 6 міст і країн, серед них є місто знаходиться в Італії надрукувати їх назва

Program as;

Uses crt;

Type

S = record

strana: string [10];

gorod: string [8];

End;

Var a: array [1 .. 6] of s;

I: integer;

Begin clrscr;

For i: = 1 to 6 do begin

Writeln ('країна?');

Readln (a [i]. Strana);

Writeln ('місто');

Readln (a [i]. Gorod);

End; Writeln; Clrscr;

For i: = 1 to 6 do if a [i]. strana = 'italia' then writeln (a [i]. gorod);

End.

Заданіе12. Дано назви 10 країн і частин світу. Надрукувати на екрані всі країни знаходяться в Азії

Program as;

Uses crt;

Type

S = record

strana: string [10];

ch: string [8];

End;

Var a: array [1 .. 10] of s;

I: integer;

Begin clrscr;

For i: = 1 to 10 do begin

Writeln ('країна');

Readln (a [i]. Strana);

Writeln ('частина світла');

Readln (a [i]. Ch);

End; Writeln; Clrscr;

For i: = 1 to 10 do if a [i]. ch = 'Azia' then writeln (a [i]. strana);

End.

Заданіе13. З відомості 3-х студентів з їх оцінками (порядковий номер, П.І.Б. та три оцінки) визначити кількість відмінників і середній бал кожного студента

Program Spic;

Type wed = record {Тип wed включає 3 поля: n, fio, bal}

n: integer;

fio: string [40];

bal: array [1 .. 3] of integer {Поле bal - масив з 3 оцінок}

end;

Var spisok: wed; {Запис spicok типу wed}

i, j, kol, s: integer; sr: real;

Begin

kol: = 0; {kol-кількість відмінників}

With spisok do {with приєднує ім'я запису spisok до всіх}

For i: = 1 to 3 do {полях всередині циклу For по i}

begin

n: = i;

Write ('Vvedite FIO #', i, '');

Readln (fio);

s: = 0;

For j: = 1 to 3 do

begin

write ('Vvedite ocenky:');

readln (bal [j]);

s: = s + bal [j];

end;

if s = 15 then kol: = kol +1; {підрахунок кількості відмінників}

sr: = s / 3; writeln (fio, ', Sredniy bal =', sr: 4:1); end;

writeln ('Kolichestvo otlichnikov =', kol);

readln;

end.

Заданіе14. Нехай нам необхідно заповнити відомості про студента (П.І.Б., дата народження, адреса, курс і група), а потім вивести ці відомості на екран

program primer1;

type anketa = record

fio: string [45];

dat_r: string [8];

adres: string [50];

curs: 1 .. 5;

grupp: string [3]

end;

var student: anketa;

begin

writeln ('введіть відомості про студента');

{Зверніть увагу, введення кожного поля здійснюється окремо}

writeln ('введіть прізвище, ім'я та по батькові');

readln (student.fio);

writeln ('введіть дату народження');

readln (student.dat_r);

writeln ('введіть адресу');

readln (student.adres);

writeln ('введіть курс');

readln (student.curs);

writeln ('введіть групу');

readln (student.grupp);

writeln ('введення закінчений');

writeln;

{Зверніть увагу, що висновок запису здійснюється по полях}

writeln ('прізвище студента:', student. fio);

writeln ('дата народження:', student.dat_r);

writeln ('адресу:', student.adres);

writeln ('курс:', student.curs);

writeln ('група:', student.grupp);

end.

Заданіе15. Нехай нам необхідно мати відомості про багатьох студентів, наприклад, нашого факультету. Отже, необхідно організувати масив записів Паскаля. А потім із загального списку вивести прізвища студентів 2-го курсу

program primer 2;

type anketa = record

fio: string [45];

dat_r: string [8];

adres: string [50];

curs: 1 .. 5;

grupp: string [3]

end;

var student: array [1 .. 100] of anketa;

I: integer;

begin

{Послідовно вводимо кожен запис}

for I: = 1 to 100 do

begin

writeln ('введіть відомості про', I, '-м студента');

writeln ('введіть прізвище, ім'я та по батькові');

readln (student [I]. fio);