Текст основной программы

program petnash;

uses

 crt,graph,

 petnash1;{Модуль,содержащий основные подпрограммы}

Var

grDriver,grMode,ErrCode,men:integer;

Begin(*petnash*)

{Инициализация графического режима}

grDriver:=Detect;

InitGraph(grDriver, grMode,'');

ErrCode := GraphResult;

if ErrCode <> grOk

 then

 begin

Writeln('Graphics error:',GraphErrorMsg(ErrCode));

Writeln('Press - <ENTER>');

Readln;

Halt;

 end;

{Установка текущих параметров цвета и линии}

setcolor( 6);

setlinestyle(0,0,1);

recod; {Считывание данных из файла с лучшими результатами}

repeat

 menu(men);{Процедура,обеспечивающая работу с меню}

 case men of

 0:game; {ИГРА}

 1:best; {ЛУЧШИЕ ИГРОКИ}

 2:help; {ОБ ИГРЕ}

end;(*case*)

until men=3; {ВЫХОД ИЗ ИГРЫ}

closegraph {Выход из графического режима в текстовой}

END.(*petnash*)

Текст модуля

Unit petnash1;

(**************)Interface(*****************)

uses

 crt,graph;

const

 {Коды клавиш,используемых в программе }

 Up=#72;

 Down=#80;

 Left=#75;

 Right=#77;

 Space=#32;

 Esc=#27;

 Enter=#13;

type

 strok=string[10];

var

 stroka:array[1..12] of strok;

 f02,f03:text;

 st02:string[10];

 stl2:string[20];

 a,b2,pl,kl,o:char;

 st,st1:string[5];

 step:string[5];

 u,vict:boolean;

 mas:array [1..16] of integer;

 a02,b3,c02,b,b1,d,e,e02,i,i1,j,n,r,steps,x,

 x1,y,y1,yme:integer;

 grDriver,grMode:integer;

 m,m1,m2,m3:integer;

 p,p1,p2,p3:pointer;

 

 procedure recod;

 procedure buk(a,b,c:integer;s:char);

 procedure victory;

 procedure nomer(xp,yp,ip:integer);

 procedure kv(xk,yk:integer);

 procedure tabl(xv,yv:integer;klv:char;var xv1,yv1:integer);

 procedure menu(var ym:integer);

 procedure game;

 procedure best;

 procedure help;

 

(*************)Implementation(****************)

 

(*Процедура считывания таблицы рекордов*)

(*из файла 'rezult.dat'*)

procedure recod;

 begin(*recod*)

 assign(f02,'rezult.dat');

 reset(f02);{Открытие файла с результатами}

 for i:=1 to 10 do {Чтение из файла}

readln(f02,stroka[i]);

 end;(*recod*)

(*Процедура движения заданной буквы по экрану *)

procedure buk(a,b,c:integer;s:char);

 begin (*buk*)

 for I:=a downto b do

begin

 {Буква рисуется темным цветом}

 setcolor(1);

 settextstyle(1,0,10);{Параметры текста}

 outtextxy(c,i,s);

 {Буква рисуется таким же цветом,

 что и фон экрана}

 setcolor(14);

 settextstyle(1,0,10);

 outtextxy(c,i,s);

end;

 {Рисование буквы по ее конечным координатам}

 setcolor(1);

 settextstyle(1,0,10);

 outtextxy(c,b,s);

end;(*buk*)

 

(*Процедура победы*)

procedure victory;

begin (*victory*)

 {Создание на желтом фоне надписи Victoty}

 setbkcolor(14);

 buk(480,220,100,'V');

 buk(480,220,170,'i');

 buk(480,220,205,'c');

 buk(480,220,255,'t');

 buk(480,220,300,'o');

 buk(480,220,359,'r');

 buk(480,220,410,'y');

 {Очерчивние надписи 2 линиями}

 setcolor(4);

 setlinestyle(0,0,3);

 for i:=115 to 405 do

 begin

delay(3);

line(i,355,i+20,355);

line(i,240,i,240);

 end;

 for i:=455 to 470 do

 begin

delay(3);

line(i,355,i+5,355)

 end

 end;(*victory*)

 

(* Процедура рисования номера пятнашки*)

procedure nomer(xp,yp,ip:integer);

 begin (*nomer*)

 {Преобразование числа mas[ip] в

 посл-ть символов}

 str(mas[ip]:1,st);

 {Вывод посл-ти символов st}

 outtextxy(175+xp*86,120+yp*86,st);

 end;(*nomer*)

 

(*Процедура рисования парал-да*)

procedure kv(xk,yk:integer);

 begin(*kv*)

bar3d(160+xk*86,100+yk*86,235+xk*86,

175+yk*86,7,true);

 end;(*kv*)

 

(*Процедура смены активной таблички*)

procedure tabl(xv,yv:integer;klv:char;var

xv1,yv1:integer);

 begin(*tabl*)

{Фишка(табличка),которая была активизирована

рисуется таким же цветом, что и остальные

фишки}

setcolor(13);

kv(xv,yv);

{Надпись номера фишки}

if mas[4*yv+xv+1]<>0 then

nomer(xv,yv,4*yv+xv+1);

{Нажатие пользователем одной из клафиш case

управления}

klv of

Down :if yv<3 then yv:=yv+1;

Up :if yv>0 then yv:=yv-1;

Left :if xv>0 then xv:=xv-1;

Right :if xv<3 then xv:=xv+1;

end;(*case*)

xv1:=xv;

yv1:=yv;

{Фишка, которая становится активизированной,

рисуется темным цветом}

setcolor(1);

kv(x,y);

{Надпись номера активизированной фишки}

if mas[4*yv+xv+1]<>0

then nomer(x,y,4*y+x+1);

 end;(*tabl*)

 

(*Процедура меню*)

procedure menu(var ym:integer);

 var

om:char;

 begin(*menu*)

ym:=0;

cleardevice; {Очистка графического экрана}

{Рисование тени пунктов меню,прямоугольники

 серого цвета}

setcolor(8);

setfillstyle(1,8);

bar(45,152,615,202);

bar(45,222,615,272);

bar(45,292,615,342);

bar(45,362,615,412);

fillellipse(304,62,210,35);

{Рисование пунктов меню,прямоугольники синего

цвета}

setcolor(1);

setfillstyle(1,1);

bar(35,145,605,195);

bar(35,215,605,265);

bar(35,285,605,335);

bar(35,355,605,405);

{Рисование эллипса под надписью ***MENU***}

fillellipse(298,57,210,35);

{Надписи на экране об авторе прграммы}

setcolor(12);

settextstyle(1,0,1);

outtextxy(20,430,'Copyright Software 1998');

outtextxy(20,450,'Written by Volkov

Konstantin');

{Надпись ***MENU*** печатается серым цветом,

тем самым создается эффект тени}

setcolor(8);

settextstyle(1,0,6);

outtextxy(142,33,'*** MENU ***');

{Печать надписи ***MENU*** синим цветом}

setcolor(10);

outtextxy(140,30,'*** MENU ***');

setbkcolor(9); {Цвет фона экрана}

repeat

 setfillstyle(1,5); {Орнамент и цвет

 заполнения полоски-указателя}

 {Полоска,передвигающаяся по пунктам меню}

 bar(35,145+70*ym,605,195+70*ym);

 {Печать пунктов меню}

 outtextxy(50,135,'Game');

 outtextxy(50,205,'Best players');

 outtextxy(50,275,'About this game');

 outtextxy(50,345,'Exit');

 om:=readkey;

 {При переходе указателя на другой пункт,

 возврашение пункту меню прежнего цвета}

 setfillstyle(1,1);

 bar(35,145+70*ym,605,195+70*ym);

 {Изменение координат указателя, в

 зависимости от нажатия пользователем

 однойиз клавиш управления}

 if om=up then ym:=ym-1;

 if om=down then ym:=ym+1;

 if ym=-1 then ym:=3;

 if ym=4 then ym:=0;

 setcolor(10); {Цвет пунктов меню}

 {Создание звукового эффекта при перемещении

 по пунктам меню}

 sound(300);

 for i:=-maxint to maxint do

 j:=j;

 nosound;

 until om=Enter ;

 end;(*menu*)

 

(* Процедура начала игры *)

procedure game;

 begin(*game*)

cleardevice; {Очистка экрана}

steps:=0;{Число шагов 0}

{Рисование области, на фоне которой будет

выводится кол-во шагов}

setfillstyle(1,3);

bar(10,90,130,155);

setfillstyle(1,7);

bar(30,120,80,145);

{Обведение области темными линиями}

setlinestyle(0,0,1);

setcolor(1);

rectangle(10,90,130,155);

rectangle(29,119,81,146);

setlinestyle(0,0,1);

{Печать надписи и кол-ва шагов,

пока число шагов просто 0}

setcolor(4);

settextstyle(0,0,1);

outtextxy(20,100,'Number steps ');

outtextxy(40,130,'0');

setcolor(13);

vict:=false; {Победа не инициализирована}

 

setfillstyle(1,14); {Параметры заполнения

кубика}

bar3d(152,86,509,445,10,true);{Рисование

коробки}

{Создание в верхней части экрана полоски и

надписи на ней}

bar(0,0,639,50);

settextstyle(7,0,5);

outtextxy(125,2,'* 15 *');

{Создание в нижней части экрана полоски и

надписи на ней}

bar(0,450,639,480);

settextstyle(7,0,3);

outtextxy(80,450,'Press Esc for quit to

main menu');

{Задание прежних параметров}

settextstyle(7,0,5);

setfillstyle(1,11);

 

{Включение генератора случайных чисел}

randomize;

{Заполнение массива случайными числами

от 1 до 15}

mas[16]:=0;

mas[1]:=random(14)+1;

n:=2;

repeat

 u:=true;

 while u do

 begin{Раскладывание пятнашек}

j:=random(15)+1;

u:=false;

for i:=1 to n-1 do

 {Проверка элементов массива на

 равенство друг другу}

 if mas[i]=j then u:=true;

 end;{Раскладывание пятнашек}

 mas[n]:=j;

 n:=n+1;

until n=16;{Условие выхода заполнение всего

массива}

 

{Рисование фишек игрового поля (табличек)}

for j:=0 to 3 do

 for i:=0 to 3 do

kv(i,j);

 

{Рисование фона на котором расположена

коробка}

setbkcolor(7);

 

{Разкраска коробки}

setfillstyle(1,8);

floodfill(157,90,13);

setfillstyle(1,3);

floodfill(168,82,13);

floodfill(513,90,13);

setfillstyle(1,11);

 

{Нумерация табличек}

n:=1;

for j:=0 to 3 do

 for i:=0 to 3 do

 if (i<>3) or (j<>3) then

begin

 nomer(i,j,n);

 n:=n+1;

end;

 

x1:=3;

y1:=3;

x:=3;

y:=3;

{Рисование таблички в нижнем правом

углу,пока не сделанно ни одного хода}

setcolor(1);

setfillstyle(1,11);

bar3d(418,358,493,433,7,true);

 

repeat

 kl:=readkey;

 tabl(x,y,kl,x,y); {Cмены активной

 таблички}

 

 {Проверка условия нажатия клавиши пробел}

 if kl=Space then

begin(*if1*)

 u:=(abs(x1-x)=1) and (abs(y1-y)=0) or

 (abs(x-x1)=0) and (abs(y1-y)=1);

 

 {Условие перестановки элементов

 массива}

 if u then

 begin(*if2*)

{Элементы массива, которые меняются

местами}

i:=4*y+x+1;

i1:=4*y1+x1+1;

setcolor(11);

nomer(x,y,i);

setcolor(13);

nomer(x1,y1,i);

n:=mas[i1]; {Перестановка элементов

массива}

mas[i1]:=mas[i];

mas[i]:=n;

x1:=x;

y1:=y;

steps:=steps+1; {Увеличение числа

шагов на единицу}

 

{Вывод на экран числа шагов}

setfillstyle(1,7);

bar(30,120,80,145);{Рисование табл.}

setcolor(4);

str(steps,st1);

settextstyle(0,0,1);

outtextxy(40,130,st1);

setcolor(13);

settextstyle(7,0,5);

setfillstyle(1,11);

{Проверка следования чисел в массиве}

u:=true;

j:=0;

n:=0;

repeat

 j:=j+1;

 n:=n+1;

 if (n<>mas[j]) and (n<>12)

 then u:=false;

 if (n=11) and (mas[12]=0)

 then j:=j+1;

until mas[j]=15;

if u and ((mas[15]=15) or

(mas[16]=15))

then

 begin(*if3*)

 pl:=Esc;{Выход из цикла}

 vict:=true;{Инициализация победы}

 end;(*if3*)

 end;(*if2*)

 end;(*if1*)

 

{Игрок нажал клавишу Esc}

 if kl=Esc

 then

 begin (*if*)

 {Помещение странички в буфер

 посредством разбиения

 ее на 4 части}

 m:=imagesize(0,0,320,240);

 getmem(p,m);

 getimage(0,0,320,240,p^);

 

 m1:=imagesize(320,0,639,240);

 getmem(p1,m1);

 getimage(320,0,639,240,p1^);

 

 m2:=imagesize(0,240,320,480);

 getmem(p2,m2);

 getimage(0,240,320,480,p2^);

 

 m3:=imagesize(320,240,639,480);

 getmem(p3,m3);

 getimage(320,240,639,480,p3^);

 

 {Вывод меню, после того как игрок

 нажал Esc}

 cleardevice;

 setbkcolor(0);

 b3:=0;

 repeat

 {Рисование двойной рамочки}

 setcolor(1);

 setlinestyle(0,0,1);

 rectangle(243,183,417,257);

 rectangle(248,188,412,252);

 setfillstyle(1,14);{Орнамент и

 цвет заполнения указателя}

 

 {Указатель-выбор пункта}

 bar(250,190+30*b3,410,220+30*b3);

 setcolor(13);

 settextstyle(8,0,1);

 outtextxy(275,195,'Continue . .

 .');

 outtextxy(275,220,'Exit ');

 b2:=readkey;

 setfillstyle(1,0);

 bar(250,190+30*b3,410,220+30*b3);

 {Движение по пунктам меню}

 if b2=up then b3:=0;

 if b2=down then b3:=1;

 if b3=0

 then kl:='z'{Выбран пункт

 Continue}

 else kl:=Esc{Выбран пункт Exit}

 until b2=Enter;

 end; (*if*)

 {Если выбран пункт Continue,то

 страничка возвращается из буфера,а

 затем буфер очищается}

 if kl='z'

 then

 begin

 cleardevice;

 setbkcolor(7);

 

 putimage(0,0,p^,normalput);

 freemem(p,m);

 

 putimage(320,0,p1^,normalput);

 freemem(p1,m1);

 

 putimage(0,240,p2^,normalput);

 freemem(p2,m2);

 

 putimage(320,240,p3^,normalput);

 freemem(p3,m3);

 

 settextstyle(7,0,5);

 setfillstyle(1,11)

 end

 until (kl=Esc) or (pl=Esc) ;

 

 {Демонстрация победы после завершения игры}

 if vict then

begin(*vict*)

 cleardevice;{Очистка экрана}

 victory;{Процедура победы}

 {Вывод на экран числа шагов,сделанных

 пользователем, и поздравления}

 setcolor(4);

 settextstyle(7,0,5);

 outtextxy(100,50,'You are win ! ! !');

 str(steps,step);

 outtextxy(100,100,'You made');

 outtextxy(150,150,step);

 outtextxy(250,150,'steps.');

 repeat

 until keypressed;

 kl:=readkey;

 i:=0;

 {Сравнение результатов}

 repeat

 i:=i+1;

 val(stroka[i*2],b,x);

 until (b>steps) or (i=6);

 {Если результат игрока превосходит один из

 результатов в таблице,он заносится в

 таблицу}

 if i<6 then

 begin(*Переформирование таблицы

 рекордов*)

 for j:=5 downto i do

 begin(*Сдвиг рекордов*)

stroka[j*2+1]:=stroka[j*2-1];

stroka[j*2+2]:=stroka[j*2];

 end;(*Сдвиг рекордов*)

{Преглашение игрока к вводу имени}

cleardevice;

setbkcolor(0);

outtextxy(10,130,'Please, enter your

name :');

 

{Создание рамочки}

setcolor(10);

rectangle(100,225,525,290);

rectangle(98,223,527,292);

{Ввод имени игрока}

kl:=readkey;

j:=1;

stroka[i*2-1]:='';

u:=not(kl=enter);

while u do

 begin(*Чтение имени игрока*)

 u:=(kl>' ') and (kl<'z') and (j<11);

 if u

 then

begin(*нц*)

 stroka[i*2-1]:=stroka[i*2-1]+kl;

 outtextxy(80+j*40,230,kl);{Печать

 буквы на новой позиции}

 j:=j+1;

end;(*кц*)

 kl:=readkey;

 u:=not(kl=Enter);

 end;(*Чтение имени игрока*)

 

 {Если игрок не ввел имя, то его имя

 Noname}

 if length(stroka[i*2-1])=0

 then stroka[i*2-1]:='Noname';

stroka[i*2]:=step;

(*Запись рекорда в файл*)

rewrite(f02);

for i:=1 to 10 do

 writeln(f02,stroka[i]);

close(f02);

 end;(*Переф. табл. рекорд.*)

end;(*vict*)

end;(*game*)

 

(*Процедура вывода таблицы рекордов*)

procedure best;

 begin(*best*)

 cleardevice; {Очистка экрана}

 {Рисование двойной рамочки}

 setlinestyle(0,0,3);

 setcolor(13);

 rectangle(13,138,621,434);

 rectangle(9,132,625,440);

 setlinestyle(0,0,1);

 {Задание параметров заполнения рамочки}

 setfillstyle(1,14);

 floodfill(24,140,13);

 {Надпись лучшие игроки}

 setcolor(10);

 settextstyle(7,0,7);

 outtextxy(30,45,'Best players are:');

 {Печать таблицы результатов}

 setcolor(13);

 settextstyle(0,0,100);

 for a02:=1 to 5 do

begin(*for a02*)

 str(a02,stl2);{Преобразование числа в

 посл-ть}

 c02:=length(stroka[a02*2-1]);

 stl2:=stl2+' '+stroka[a02*2-1];

 for e02:=1 to 11-c02 do{Разделение имени

 игрока и результата точками}

 stl2:=stl2+'.';

 for e02:=1 to 5-length(stroka[a02*2]) do

 stl2:=stl2+'.';

 stl2:=stl2+stroka[a02*2];

 outtextxy(40,100+50*a02,stl2);

 if a02<>0 then setcolor(9); {Выделение

 лучшего игрока другим цветом}

 end;(*for a02*)

 repeat

 until keypressed;

 kl:=readkey;

 setcolor(13);

 end;(*best*)

 

(*Процедура вывода помощи*)

procedure help;

 var

 st3:string;

 begin(*help*)

 assign(f03,'pravila.dat');

 reset(f03); {Открытие файла pravila.dat}

 closegraph; {Выход из графического режима}

 clrscr; {Очистка экрана}

 kl:='n';

 while not(eof(f03)) {Не конец файла} and

 (kl<>Esc) {Не нажата кл. Esc} do

 begin {нц1}

 i:=1;

 while (i<25) {Страница} and not(eof(f03)) do

 begin {нц2}

i:=i+1;

readln(f03,st3); {Чтение из файла

элементов строки st3}

writeln('',st3); {Печать

содержимого строки st3 }

{Условие необходимое для того,

чтобы в конце не нажимать Enter 2 раза}

if eof(f03)

then kl:=enter

else kl:=#10

 end;{кц2}

 gotoxy(12,25);

 repeat {Ожидание нажатия клавиши Enter

 или Esc}

 if keypressed then kl:=readkey;

 until (kl=enter) or (kl=esc);

end;{кц1}

clrscr;

gotoxy(21,12);

writeln('Нажмите любую клавишу для выхода в

меню');

repeat

until keypressed;

kl:=readkey;

kl:='n';

{Инициализация графического режима и установка

прежних параметров}

InitGraph(grDriver, grMode,'');

setbkcolor(11);

setcolor(13);

setlinestyle(0,0,3);

 end;(*help*)

END.

Описания используемых типов, глобальныхпеременных, процедур и функций.

 

В программе <15> были использованы следующие типы:

 

type

strok = string[10];

 

Данный тип используется в файле, который хранит результаты лучших игроков.

В программе <15> были использованы следующие глобальные переменные:

 

 Stroka : array[1..12] of strok;

Массив, элементами которого являются строки длинною в десять символов, используется в файле, который хранит результаты лучших игроков.

 

f02,f03:text;

Текстовые переменные (файлов rezult.dat,pravila.dat)

 

st02:string[10];

Cтрока длинною в 10 символов,используется для работы с таблицей

 

stl2:string[20];

Строка длинною в 20 символов,используется для работы с таблицей

 

a,b2,pl,kl,o:char;

Переменные,которым присваиваются значения различных клавиш

 

st:string[5];

Номер фишки

st1,step:string[5];

Число ходов,преобразованных в последовательность символов

 

u:boolean;

Логическая переменная,принимающая значение true или false,используется при чтении имени игрока

 

vict:boolean;

Инициализирует процедуру победы,в случае если vict=true

 

mas:array [1..16] of integer;

Массив номеров фишек,элемент массива принимает случайное значение от 1 до 16

 

p,p1,p2,p3:pointer;

Переменная типа-указатель, в которую помещается адрес выделенной области

 

m,m1,m2,m3:integer;

Размер создаваемой переменной в байтах

 

Далее идет описание переменных типа integer :

grDriver-тип графического драйвера

ErrCode-значение ф-ии graphresult

i,j,n-параметры циклов

 

i1-номер пустой позиции

grMode-режим работы граф. адаптера

steps-текущее кол-во шагов

x,x1,y,y1-относительные координаты

 

st02-имя или кол-во очков игрока

a02-параметр цикла

c02-длина имени игрока

e02-параметр цикла

 

b- кол-во очков в табл. рекордов

men- положение курсора в меню

 

Процедуры

 

procedure recod;

Данная процедура осуществляет считывание данных из файла, содержащего имена и результаты лучших игроков

 

procedure zz1(a,b,c:integer;s:char);

Используется для перемещения заданной буквы по экрану

 

procedure victory;

Создает эффект осыпания букв на экран. В результате получается надпись Victory.

 

procedure nomer(xp,yp,ip:integer);

Преобразует номер пятнашки в последовательность символов, с последующей печатью на соответствующей фишке

 

procedure kv(xk,yk:integer);

Рисование параллелепипеда

 

Procedure tabl(xv,yv:integer;klv:char;var xv1,yv1:integer);

Процедура смены активной табличики. В зависимости от того, какая клавиша нажата UP,DOWN,LEFT,RIGHT соответствующим образом изменяются координаты таблички, и та фишка, которая была активизирована, рисуется таким же цветом, как и все остальные, а новая активизированная фишка прорисовывается другим цветом.

 

procedure menu(var ym:integer);

Обеспечивает работу пользователя с меню и создание интерфейсной части меню программы <15> (более подробно эта процедура описывается в разделе алгоритмизации)

 

procedure game;

Процедура начала игры, осуществляет подготовку к игре всех необходимых параметров и обеспечивает сам процесс игры

 

procedure best;-процедура вывода в графическом режиме таблицы с лучшими результатами

 

procedure help;-процедура вывода помощи в игре

Последние три процедуры подробно описываются в разделе алгоритмизации.

Назначение и область применения программы.

 

 Цель создания данной программы - развлечение играющих, совершенствование их умственного и логического мышления. Программа может применяться в качестве игровой на разных типах персональных компьютеров и распространяется как freeware, при соблюдении условия as is.

 

Входные и выходные данные.

 

 Входные данные - коды нажатых в режиме реального времени клавиш, а именно клавиши управления курсором UP, DOWN, LEFT, PIGHT, а так же ESC и ENTER.

 Выходные данные - графическая информация на дисплее, файлы данных, содержащие список рекордов и помощь игроку.

 

Используемые технические и программные средства

 

 Программа была написана и откомпилирована наPent 733/256/64mGF/40Gb под управлением операционной системы WinXp.

 Техническая документация к игровой программе <15> была подготовлена с помощью Microsoft Word 2002 в операционной среде WINDOWS XP.

 Текст программы написан в среде программирования Borland Pascal 7.0