YY1: INTEGER; {ПЕРЕМЕННЫЕ ИСПОЛЬЗУЮТСЯ ДЛЯ КООРДИНАЦИИ КВАДРАТОВ}
2. Procedure exchange_furniture(KX, KY: integer Room: furniture)
Процедура предназначена для перестановки предметов мебели. в качестве параметров значений из основной программы передаются KX, KY : integer – текущие координаты курсора, и Room : furniture – массив мебели, процедура вычисляет координаты пустого квадрата и проверяет его соседство с выбранным элементом мебели.
в подпрограмме используются следующие переменные:
a : string; //элемент для поиска координат пустого квадрата
i, j: integer; //счетчики циклов.
3. Function Win(Room: Furniture) :boolean
Функция проверяет выполнены ли условия победы. Результат функции логическое выражение. Если выполнены то выводится текстовое окно со словом «победа!!!» и игра заканчивается, в качестве параметра значения в функцию из основной программы передается массив мебели Room: furniture.
В основной программе используются переменные
VAR
Room: Furniture; массив мебели
KX,KY: integer; текущие координаты курсора
Ch: char; код нажатой клавиши.
текст программы к модулю MENU:
{-----------ВЕРТИКАЛЬНОЕ МЕНЮ----------------}
{Вызов пунктов меню клавишами СТРЕЛКА-ВВЕРХ и СТРЕЛКА-ВНИЗ}
unit Menu;
interface
USES Crt;
CONST
NumberMenu = 3;
VAR
i,j : integer;
TextMenu : array[1..3] of string[28];
ch : char;
EndWork : boolean;
procedure Writemenu;
implementation
{-----Выводится пункт меню с заданным номером------}
PROCEDURE WriteMenu;
begin
GotoXY (2, i * 2) ;
Write (TextMenu[i]);
END;
BEGIN
TextMenu[1]:=' О программе ';
TextMenu[2]:=' Как играть ';
TextMenu[3]:=' В игру!!!! ';
EndWork := false;
repeat
TextBackGround(3);
ClrScr;
{------Тень около окна вывода------}
Window(26,7,46,19);
TextBackGround(0);
ClrScr;
{-------Окно вывода меню-------}
Window(25,6,45,18);
TextBackGround(7) ;
ClrScr;
{------Вывод меню------}
TextColor(4);
for i:=1 to NumberMenu do WriteMenu;
i:=1;
TextColor(14) ;
TextBackGround(1);
WriteMenu;
repeat
ch:=ReadKey;
if ch = #0 then
begin
ch:=readkey;
case ch of
#72 : begin { Стрелка вверх }
textcolor(4);
textbackground(7);
WriteMenu;
dec(i);
if i<1 then i:= NumberMenu;
textcolor(14);
textbackground(1);
WriteMenu;
end;
#80 : begin { Стрелка Вверх }
textcolor(4);
textbackground(7);
WriteMenu;
inc(i);
if i > NumberMenu then i:=1;
textcolor(14);
textbackground(1);
WriteMenu;
end;
end;
end;
until ch = #13; { код клавиши Enter }
case i of
1: begin
Window(1,1,80,25);
TextBackGround(1);
ClrScr;
TextColor(15);
Writeln(' Программа как практическая задача к курсовой работе ');
writeln(' за первый курс обучения в АлтГТУ на факультете "прикладная ');
writeln(' информатика в экономике" и представляет собой логическую игру ');
writeln(' программу разработал студент группы Зр-(з)-ПИЭ-81 ');
writeln(' Снежков Алексей Владимирович ');
Readln;
ClrScr;
end;
2: begin
Window(2,2,70,23);
TextBackGround(1);
ClrScr;
TextColor(15);
Writeln(' Для перемещения курсора по игровому полю используйте клавиши ');
writeln(' со стрелками. Для перемещения элемента наведите на него курсор' );
writeln(' и нажмите "enter", элемент переместится в пустой квадрат если ');
writeln(' он находится по-соседству по вертикали или горизонтали. ');
writeln(' для выхода из игры нажмите клавишу "esc" ');
Readln;
end;
3: EndWork:=true;
end;
until EndWork;
Window(1,1,80,25);
TextBackGround(0);
TextColor(15);
ClrScr;
END.
Текст основной программы:
PROGRAM CRT_GAME_FURNITURE;
Uses
Crt, MENU;
Const
x=30; {координаты для определения }
y=20; {текстового окна }
xx=40; {у нас будет массив таких }
yy=30; {окон }
//======================================================
LU=#219; {идентификаторам присваиваем }
RU=#191; {коды символов псевдографики }
LD=#197; {с их помощью будем оформлять }
RD=#215; { квадраты }
H=#196; { }
V=#179; { }
Type
FURNITURE = array [1..2,1..3] of string; {массив для работы с процедурами и функциями. и упрорядоченного вывода квадратов}
//==================================================================//
//в этой процедуре выводится на экран массив обстановки, квадрат
//другого цвета имитирует курсор и указывает какой элемент обстановки
//будет обработан
//==================
procedure DrawRoom(KX, KY: integer;{координаты курсора} Room:Furniture{массив обстановки});
var
i, j, k: integer; {переменные - счетчики циклов}
X1, Y1, XX1, YY1: INTEGER; {ПЕРЕМЕННЫЕ ИСПОЛЬЗУЮТСЯ ДЛЯ КООРДИНАЦИИ КВАДРАТОВ}
begin
clrscr;
X1:=x;
Y1:=y;
XX1:=xx;
YY1:=yy;
for i := 1 to 2 do
begin
for j := 1 to 3 do
begin
if (KX = i) and (KY = j) then //это квадрат выбранный пользователем
TextBackGround(Green) //для перестановки в другое место, принажатии 'enter'
else
TextBackGround(Yellow); //устанавливаем цвет невыбранного квадрата.
TextColor(black); //цвет текста в квадратах
// рисуем квадрат, по условию цикла их будет 6 в виде многомерного массива
window(X1, Y1, XX1, YY1);
ClrScr;
//оформляем его рамкой
write(LU); {верхний левый угол}
//верхняя горизонтальная линия (т.к курсор в данный момент вверху окна
for k := X1+1 to XX1-1 do write (h);
// т.к. курсор находится в правом верхнем углу рисуем верхний правый угол
write(RU);
//вывод вертикальных линий
for k := Y1+1 to YY1-1 do
begin
GOTOXY(1, k-Y1+1); //курсор в левой позиции окна
// левая вертикальная линия
write(V);
GOTOXY(XX1-X1+1, WhereY); // курсор в правой границе
Write(V); //рисуем правую вертикальную линию
end;
write(LD); // левый нижний угол
//нижняя горизонтальная линия
GoToXY(2, YY1-Y1+1);
for k := X1+1 to XX1-1 do write(H);
write(RD); // правый нижний угол
// внутренняя часть окна
window(X1+1, Y1+1, XX1-1, YY1-1);
{вывод предмета мебели соответствующего координатам квадрата}
Write(Room[i, j]);
// координаты нового окна
X1 := X1+10;
XX1 := XX1+10;
end;
//координаты нового окна
Y1 := Y1+10; YY1 := YY1+10; X1 := x; XX1 := xx;
end;
end;
//================================================================================
//процедура перстановки мебели. вызывается нажатием 'enter' сначала прверяем |
//есть ли в раионе выбранного квадрата пустой квадрат и если есть то ставим |
// туда выбранный предмет |
//======================================== |
procedure exchange_furniture(KX, KY: integer; //координаты выбранного квадрата
var room: furniture); //массиив обстановки
var
a : string; //элемент для поиска координат пустого квадрата
i, j: integer; //счетчики циклов.
begin
for i := 1 to 2 do
begin // циклы перебора всех елементов массива для поиска
for j := 1 to 3 do // координат пустого квадрата
if (Room[i, j] = ' ') then
begin
if (i+1 = KX) and (j=KY) or (i-1=KX) and (j=KY) then
a := ' ';
if (j+1=KY) and (i=KX) or (j-1=KY) and (i=KX) then
a := ' ';
if (a =' ') then
begin
Room[i, j] := Room[KX, KY];
Room[KX, KY] :=' ';
end;
end;
end;
end;
//===========================================================================
// функция которая проверяет выполнена ли задача для выигрыша, результат
// функции логическое выражение
//==============================
function Win(Room: Furniture) :boolean;
begin
// по условию задачи, для победы, шкаф и кресло должны поменяться местами
if (Room[1, 3] = 'Кресло') and (Room[2, 3] = 'Шкаф') then
begin
window(20, 22, 29, 28); // определяем текстовое окно
TextBackGround(red); // цвет фона (красный)
TextColor(white+blink); // цвет текста (белые мерцающие символы)
GotoXY(22, 25); // перемещаем курсор в нужную позицию
writeln('Победа!!!'); // выводим сообщение
TextColor(lightGray); // восстанавливаем цвет текста
win := true; // присваиваем "истина"
end
else
Win := false; // иначе ложь
end;
///////////////////////////////////////////////////////////////////////////////
//основная прграмма которая будет вызывать процедуры и функции и использовать /
// результаты их работы /
///////////////////////////////////////////////////////// /
VAR
Room: Furniture;
KX,KY: integer;
Ch: char;
BEGIN
ClrScr;
WriteMenu;
begin {если нет то массив заполняется как в задании}
Room[1, 1]:='Стол'; Room[1, 2]:='Стул'; Room[1,3]:='Шкаф';
Room[2, 1]:='cтул'; Room[2, 2]:=' '; Room[2, 3]:='Кресло';
KX:=1; KY:=1; {устанавливаем начальное положение курсора}
TextBackGround(cyan);
ClrScr;
DrawRoom(KX, KY, Room);
repeat
begin
ch:=ReadKey;
case ch of
#75: {нажали клавишу "влево"}
begin
if KY <> 1 then
begin
KY:= KY - 1;
DrawRoom(KX, KY, Room);
end;
end;
#77: {нажали "вправо"}
begin
if KY <> 3 then
begin
KY:=KY + 1;
DrawRoom(KX, KY, Room);
end;
end;
#80: {нажали "вниз}
begin
if KX <> 2 then
begin
KX:=KX + 1;
DrawRoom(KX, KY, Room);
end;
end;
#72: {нажали "вверх"}
begin
if KX <> 1 then
begin
KX:=KX - 1;
DrawRoom(KX, KY, Room);
end;
end;
#13: {нажали "enter" если квадрат не пуст то перемещаем выбранный
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.
