1.14 Задача № 14 «Светофор»
Цель работы - создать программу, выполняющую следующие действия:
1. После запуска программы в окне изображается светофор с тремя лампочками,
способными реагировать на наведение указателя мыши.
2. Когда указатель мыши наведен на лампочку, она меняет свой цвет.
4. Написать функцию OnShape, которая вызывается из процедуры FormMouseMove.
5. Работа функции определяет следующие события:
Если указатель мыши не наведен на лампочку, то ее цвет будет прозрачным.
Если указатель мыши наведен на лампочку, то ее цвет будет соответствовать
цветам светофора.
type
TForm1 = class(TForm)
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
function OnShape(sh: TShape; X, Y: Integer): TBrushStyle;
public
{ Public declarations }
end;
var
Form1: TForm1;
Implementation
{$R *.dfm}
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
S
hape1.Brush.Color
:= clRed;
Shape1.Brush.Style := OnShape (Shape1, X, Y);
Shape2.Brush.Color := clYellow;
Shape2.Brush.Style := OnShape (Shape2, X, Y);
Shape3.Brush.Color := clLime;
Shape3.Brush.Style := OnShape (Shape3, X, Y);
end;
function TForm1.OnShape;
var r, cx, cy, d2: Integer; Рисунок 16
begin
r := sh.Width div 2; {r - радиус фигуры}
cx := sh.Left + r; {cx, cy – координаты центра фигуры}
cy := sh.Top + r;
d2 := (X - cx) * (X - cx) + (Y - cy) * (Y - cy); {d2 – квадрат расстояния от центра}
OnShape := bsSolid; {указатель мыши не наведен на лампочку, т.е. находиться за
пределами фигуры}
if d2 > r*r then OnShape := bsClear; {указатель мыши наведен на лампочку, т.е.
находиться внутри фигуры}
end;
end.
1.15 Задача № 15 «Ханойские башни»
Цель работы - создать компьютерную версию игры-головоломки «Ханойские
башни». Игровая доска содержит семь клеток, расположенных в ряд. На трех левых клетках
стоят белые фишки, на трех правых – черные. Центральная клетка пуста. Задача заключается
в том, чтобы, делая допустимые ходы, поменять фишки местами. Правила ходов такие.
1. Белые фишки могут ходить только вправо, а черные – только влево.
2. Ходить разрешается только на свободное поле.
3. Разрешены перемещения на соседнее поле и «прыжок» через одну фишку.
В роли фишек выступают кнопки с изображением, например, цветных треугольников,
направленных так, чтобы они указывали допустимое направление ходов. Кнопки будут
передвигаться по игровой доске, созданной при помощи панели.
Листинг программы:
var
Form1: TForm1;
Implementation
{$R *.dfm}
var n: Integer = 4;
win : Integer = 24;
procedure TForm1.BitBtn1Click(Sender: TObject);
Var I, c, k, ak: Integer;
begin
with Sender as TBitBtn do {объект Sender используется многократно}
begin {свойство Tag указывает, какая именно кнопка нажата}
i := Tag div 2; {переменная i хранит номер клетки, где находится кнопка}
c := Tag mod 2; {переменная c определяет цвет фишки}
k := n - i; {k – величина перемещения}
ak := Abs (k); {ak – длина хода}
if ak < 3 then {проверка допустимости хода}
if ((c = 0) and (k > 0)) or ((c = 1 ) and (k < 0)) {белые фишки могут ходить только
вправо, черные - влево}
then {делаем ход}
begin
Tag := Tag + 2 * k;
Left := Left + 56 * k;
win := win - ak; {при каждом ходе уменьшается значение
переменой win на длину хода}
n := i; {пустая клетка находиться там, где раньше была фишка}
end;
end;
if win = 0 then {проверка завершения решения}
begin
Caption := 'Победа!';
Panel1.Color := clFuchsia;
Panel1.Enabled := False; {отключаем панель, и одновременно все расположенные на
ней объекты}
end;
end;
e
nd.
Рисунок 17
2.1 Задача № 1 ‘Begin10’
Даны два ненулевых числа. Найти сумму, разность, произведение и частное их квадратов.
Листинг программы:
Program Begin10;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
a, b: real;
begin
WriteLn('Введите число a');
ReadLn(a);
a := Sqr(a);
WriteLn('Введите число b');
ReadLn(b);
b := Sqr(b);
WriteLn('сумма квадратов = ', FloatToStr(a + b));
WriteLn('разность квадратов = ', FloatToStr(a - b));
WriteLn('произведение квадратов = ', FloatToStr(a * b));
WriteLn('частное квадратов = ', FloatToStr(a / b));
end.
2.2 Задача № 2 ‘If21’
Даны целочисленные координаты точки на плоскости. Если точка совпадает с началом координат, то вывести 0. Если точка не совпадает с началом координат, но лежит на оси OX или OY, то вывести соответственно 1 или 2. Если точка не лежит на координатных осях, то вывести 3.
Листинг программы:
Program IF21;
{$APPTYPE CONSOLE}
var
x, y: integer;
begin
Writeln('Введите X координату точки');
Readln(x);
Writeln('Введите Y координату точки');
Readln(y);
if (x = 0) and (y = 0) then
Writeln(0)
else if y = 0 then
Writeln(1)
else if x = 0 then
Writeln(2)
else
Writeln(3);
end.
2.3 Задача № 3 ‘Case 10’
Робот может перемещаться в четырех направлениях («С» — север, «З» — запад, «Ю» — юг, «В» — восток) и принимать три цифровые команды: 0 — продолжать движение, 1 — поворот налево, 1 — поворот направо. Дан символ C — исходное направление робота и целое число N — посланная ему команда. Вывести направление робота после выполнения полученной команды.
Листинг программы:
Program Case10;
{$APPTYPE CONSOLE}
var
C: Char;
N: Integer;
begin
WriteLn(
'Введите исходное направление робота ("С"-север, "З"-запад, "Ю"-юг, "В"-восток)');
ReadLn(C);
WriteLn('Введите посланную ему команду (-1, 0, 1)');
ReadLn(N);
case C of
'C':
case N of
-1:
C := 'В';
0:
C := 'C';
1:
C := 'З';
else
Writeln('ошибка');
end;
'З':
case N of
-1:
C := 'С';
0:
C := 'З';
1:
C := 'Ю';
else
Writeln('ошибка');
end;
'Ю':
case N of
- 1:
C := 'З';
0:
C := 'Ю';
1:
C := 'В';
else
Writeln('ошибка');
end;
'В':
case N of
- 1:
C := 'Ю';
0:
C := 'В';
1:
C := 'С';
else
Writeln('ошибка');
end;
else
Writeln('ошибка');
end;
Writeln('Направление робота после выполнения полученной команды: ', C);
end.
2.4 Задача № 4 ‘For31’
Дано целое число N (> 0). Последовательность вещественных чисел AK определяется следующим образом:
A0 = 2, AK = 2 + 1/AK–1, K = 1, 2, … .
Вывести элементы A1, A2, …, AN.
Листинг программы:
Program For31;
{$APPTYPE CONSOLE}
var
i, N: integer;
A: real;
begin
WriteLn('Введите целое число N > 0');
ReadLn(N);
A := 2;
WriteLn('Элементы A1,A2,...An :');
for i := 1 to N do
begin
A := 2 + 1 / A;
WriteLn(A);
end;
end.
2.5 Задача № 5 ‘While10’
Дано целое число N (> 1). Найти наибольшее целое число K, при котором выполняется неравенство 3K < N.
program Project1;
{$APPTYPE CONSOLE}
var
N, K: Integer;
begin
WriteLn('Введите N > 1');
ReadLn(N);
K := Round(N / 3);
while (3 * K) >= N do Dec(K);
WriteLn('K = ', K);
end.
2.6 Задача № 6 ‘Series31’
Даны целые числа K, N, а также K наборов целых чисел по N элементов в каждом наборе. Найти количество наборов, содержащих число 2. Если таких наборов нет, то вывести 0.
Листинг программы:
program Series31;
{$APPTYPE CONSOLE}
var
K, N, i, j, a, nc: integer;
bol: boolean;
begin
WriteLn('Введите число наборов K');
ReadLn(K);
WriteLn('Введите число элементов в каждом наборе N');
ReadLn(N);
nc := 0;
for i := 1 to K do
begin
bol := false;
for j := 1 to N do
begin
WriteLn('Введите ', j, '-е число ', i, '-го набора');
Read(a);
if a = 2 then
bol := true;
end;
if bol then
inc(nc);
end;
WriteLn('Количество наборов, содержащих число 2: ', nc);
end.
2.7 Задача № 7 ‘Minmax10’
Дано целое число N и набор из N целых чисел. Найти номер первого экстремального (то есть минимального или максимального) элемента из данного набора.
Листинг программы:
program Minmax10;
{$APPTYPE CONSOLE}
var
otvet, a, N, i, max, min, maxn, minn: integer;
begin
Writeln('Введите число N');
Readln(N);
Writeln('Введите ', N, ' целых чисел.');
min := 0;
minn := 0;
max := 0;
maxn := 0;
for i := 1 to N do
begin
Read(a);
if (a > max) or (maxn = 0) then
begin
max := a;
maxn := i;
end;
if (a < min) or (minn = 0) then
begin
min := a;
minn := i;
end;
end;
if minn > maxn then
otvet := maxn
else
otvet := minn;
Writeln;
Writeln('Номер первого экстремального элемента = ', otvet);
end.
Блок схема № 7
2.8 Задача № 8 ‘Array131’
Дано
множество A
из
N
точек
на плоскости и точка B
(точки
заданы своими координатами x,
y).
Найти
точку из множества A,
наиболее
близкую к точке B.
Расстояние
R
между
точками с координатами (x1,
y1)
и
(x2,
y2)
вычисляется
по формуле:
Блок схема № 8
Листинг программы:
program Array131;
{$APPTYPE CONSOLE}
var
X: array [1 .. 20] of Integer;
Y: array [1 .. 20] of Integer;
n, Tohka, BX, BY, i: Integer;
minR, R: Real;
begin
Writeln('Введите N (N<=20)');
Readln(n);
Writeln('Введите координаты точки В, X и Y');
Read(BX);
Readln(BY);
Writeln('Значения множества точек А (X Y)');
for i := 1 to n do
begin
Write(i, '-я точка: ');
Read(X[i]);
Read(Y[i]);
end;
// решение
minR := (Sqrt(Sqr(X[1] - BY) + Sqr(BX - Y[1])));
Tohka := 1;
for i := 1 to n do
begin
R := Sqrt(Sqr(X[i] - BX) + Sqr(Y[i] - BX));
if R < minR then
begin
minR := R;
Tohka := i;
end;
end;
Writeln;
Writeln('Ответ:');
Write(Tohka, '-я точка с координатами ', X[Tohka], ' ', Y[Tohka]);
end.